{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A spring-based [class/@animation@/].
-- 
-- @AdwSpringAnimation@ implements an animation driven by a physical model of a
-- spring described by [struct/@springParams@/], with a resting position in
-- [property/@springAnimation@/:value-to], stretched to
-- [property/@springAnimation@/:value-from].
-- 
-- Since the animation is physically simulated, spring animations don\'t have a
-- fixed duration. The animation will stop when the simulated spring comes to a
-- rest - when the amplitude of the oscillations becomes smaller than
-- [property/@springAnimation@/:epsilon], or immediately when it reaches
-- [property/@springAnimation@/:value-to] if
-- [property/@springAnimation@/:clamp] is set to @TRUE@. The estimated duration can
-- be obtained with [property/@springAnimation@/:estimated-duration].
-- 
-- Due to the nature of spring-driven motion the animation can overshoot
-- [property/@springAnimation@/:value-to] before coming to a rest. Whether the
-- animation will overshoot or not depends on the damping ratio of the spring.
-- See [struct/@springParams@/] for more information about specific damping ratio
-- values.
-- 
-- If [property/@springAnimation@/:clamp] is @TRUE@, the animation will abruptly
-- end as soon as it reaches the final value, preventing overshooting.
-- 
-- Animations can have an initial velocity value, set via
-- [property/@springAnimation@/:initial-velocity], which adjusts the curve without
-- changing the duration. This makes spring animations useful for deceleration
-- at the end of gestures.
-- 
-- If the initial and final values are equal, and the initial velocity is not 0,
-- the animation value will bounce and return to its resting position.

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

module GI.Adw.Objects.SpringAnimation
    ( 

-- * Exported types
    SpringAnimation(..)                     ,
    IsSpringAnimation                       ,
    toSpringAnimation                       ,


 -- * 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"), [calculateValue]("GI.Adw.Objects.SpringAnimation#g:method:calculateValue"), [calculateVelocity]("GI.Adw.Objects.SpringAnimation#g:method:calculateVelocity"), [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"), [pause]("GI.Adw.Objects.Animation#g:method:pause"), [play]("GI.Adw.Objects.Animation#g:method:play"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [reset]("GI.Adw.Objects.Animation#g:method:reset"), [resume]("GI.Adw.Objects.Animation#g:method:resume"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [skip]("GI.Adw.Objects.Animation#g:method:skip"), [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
-- [getClamp]("GI.Adw.Objects.SpringAnimation#g:method:getClamp"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getEpsilon]("GI.Adw.Objects.SpringAnimation#g:method:getEpsilon"), [getEstimatedDuration]("GI.Adw.Objects.SpringAnimation#g:method:getEstimatedDuration"), [getFollowEnableAnimationsSetting]("GI.Adw.Objects.Animation#g:method:getFollowEnableAnimationsSetting"), [getInitialVelocity]("GI.Adw.Objects.SpringAnimation#g:method:getInitialVelocity"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getSpringParams]("GI.Adw.Objects.SpringAnimation#g:method:getSpringParams"), [getState]("GI.Adw.Objects.Animation#g:method:getState"), [getTarget]("GI.Adw.Objects.Animation#g:method:getTarget"), [getValue]("GI.Adw.Objects.Animation#g:method:getValue"), [getValueFrom]("GI.Adw.Objects.SpringAnimation#g:method:getValueFrom"), [getValueTo]("GI.Adw.Objects.SpringAnimation#g:method:getValueTo"), [getVelocity]("GI.Adw.Objects.SpringAnimation#g:method:getVelocity"), [getWidget]("GI.Adw.Objects.Animation#g:method:getWidget").
-- 
-- ==== Setters
-- [setClamp]("GI.Adw.Objects.SpringAnimation#g:method:setClamp"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setEpsilon]("GI.Adw.Objects.SpringAnimation#g:method:setEpsilon"), [setFollowEnableAnimationsSetting]("GI.Adw.Objects.Animation#g:method:setFollowEnableAnimationsSetting"), [setInitialVelocity]("GI.Adw.Objects.SpringAnimation#g:method:setInitialVelocity"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setSpringParams]("GI.Adw.Objects.SpringAnimation#g:method:setSpringParams"), [setTarget]("GI.Adw.Objects.Animation#g:method:setTarget"), [setValueFrom]("GI.Adw.Objects.SpringAnimation#g:method:setValueFrom"), [setValueTo]("GI.Adw.Objects.SpringAnimation#g:method:setValueTo").

#if defined(ENABLE_OVERLOADING)
    ResolveSpringAnimationMethod            ,
#endif

-- ** calculateValue #method:calculateValue#

#if defined(ENABLE_OVERLOADING)
    SpringAnimationCalculateValueMethodInfo ,
#endif
    springAnimationCalculateValue           ,


-- ** calculateVelocity #method:calculateVelocity#

#if defined(ENABLE_OVERLOADING)
    SpringAnimationCalculateVelocityMethodInfo,
#endif
    springAnimationCalculateVelocity        ,


-- ** getClamp #method:getClamp#

#if defined(ENABLE_OVERLOADING)
    SpringAnimationGetClampMethodInfo       ,
#endif
    springAnimationGetClamp                 ,


-- ** getEpsilon #method:getEpsilon#

#if defined(ENABLE_OVERLOADING)
    SpringAnimationGetEpsilonMethodInfo     ,
#endif
    springAnimationGetEpsilon               ,


-- ** getEstimatedDuration #method:getEstimatedDuration#

#if defined(ENABLE_OVERLOADING)
    SpringAnimationGetEstimatedDurationMethodInfo,
#endif
    springAnimationGetEstimatedDuration     ,


-- ** getInitialVelocity #method:getInitialVelocity#

#if defined(ENABLE_OVERLOADING)
    SpringAnimationGetInitialVelocityMethodInfo,
#endif
    springAnimationGetInitialVelocity       ,


-- ** getSpringParams #method:getSpringParams#

#if defined(ENABLE_OVERLOADING)
    SpringAnimationGetSpringParamsMethodInfo,
#endif
    springAnimationGetSpringParams          ,


-- ** getValueFrom #method:getValueFrom#

#if defined(ENABLE_OVERLOADING)
    SpringAnimationGetValueFromMethodInfo   ,
#endif
    springAnimationGetValueFrom             ,


-- ** getValueTo #method:getValueTo#

#if defined(ENABLE_OVERLOADING)
    SpringAnimationGetValueToMethodInfo     ,
#endif
    springAnimationGetValueTo               ,


-- ** getVelocity #method:getVelocity#

#if defined(ENABLE_OVERLOADING)
    SpringAnimationGetVelocityMethodInfo    ,
#endif
    springAnimationGetVelocity              ,


-- ** new #method:new#

    springAnimationNew                      ,


-- ** setClamp #method:setClamp#

#if defined(ENABLE_OVERLOADING)
    SpringAnimationSetClampMethodInfo       ,
#endif
    springAnimationSetClamp                 ,


-- ** setEpsilon #method:setEpsilon#

#if defined(ENABLE_OVERLOADING)
    SpringAnimationSetEpsilonMethodInfo     ,
#endif
    springAnimationSetEpsilon               ,


-- ** setInitialVelocity #method:setInitialVelocity#

#if defined(ENABLE_OVERLOADING)
    SpringAnimationSetInitialVelocityMethodInfo,
#endif
    springAnimationSetInitialVelocity       ,


-- ** setSpringParams #method:setSpringParams#

#if defined(ENABLE_OVERLOADING)
    SpringAnimationSetSpringParamsMethodInfo,
#endif
    springAnimationSetSpringParams          ,


-- ** setValueFrom #method:setValueFrom#

#if defined(ENABLE_OVERLOADING)
    SpringAnimationSetValueFromMethodInfo   ,
#endif
    springAnimationSetValueFrom             ,


-- ** setValueTo #method:setValueTo#

#if defined(ENABLE_OVERLOADING)
    SpringAnimationSetValueToMethodInfo     ,
#endif
    springAnimationSetValueTo               ,




 -- * Properties


-- ** clamp #attr:clamp#
-- | Whether the animation should be clamped.
-- 
-- If set to @TRUE@, the animation will abruptly end as soon as it reaches the
-- final value, preventing overshooting.
-- 
-- It won\'t prevent overshooting [property/@springAnimation@/:value-from] if a
-- relative negative [property/@springAnimation@/:initial-velocity] is set.

#if defined(ENABLE_OVERLOADING)
    SpringAnimationClampPropertyInfo        ,
#endif
    constructSpringAnimationClamp           ,
    getSpringAnimationClamp                 ,
    setSpringAnimationClamp                 ,
#if defined(ENABLE_OVERLOADING)
    springAnimationClamp                    ,
#endif


-- ** epsilon #attr:epsilon#
-- | Precision of the spring.
-- 
-- The level of precision used to determine when the animation has come to a
-- rest, that is, when the amplitude of the oscillations becomes smaller than
-- this value.
-- 
-- If the epsilon value is too small, the animation will take a long time to
-- stop after the animated value has stopped visibly changing.
-- 
-- If the epsilon value is too large, the animation will end prematurely.
-- 
-- The default value is 0.001.

#if defined(ENABLE_OVERLOADING)
    SpringAnimationEpsilonPropertyInfo      ,
#endif
    constructSpringAnimationEpsilon         ,
    getSpringAnimationEpsilon               ,
    setSpringAnimationEpsilon               ,
#if defined(ENABLE_OVERLOADING)
    springAnimationEpsilon                  ,
#endif


-- ** estimatedDuration #attr:estimatedDuration#
-- | Estimated duration of the animation, in milliseconds.
-- 
-- Can be [const/@dURATIONINFINITE@/] if the spring damping is set to 0.

#if defined(ENABLE_OVERLOADING)
    SpringAnimationEstimatedDurationPropertyInfo,
#endif
    getSpringAnimationEstimatedDuration     ,
#if defined(ENABLE_OVERLOADING)
    springAnimationEstimatedDuration        ,
#endif


-- ** initialVelocity #attr:initialVelocity#
-- | The initial velocity to start the animation with.
-- 
-- Initial velocity affects only the animation curve, but not its duration.

#if defined(ENABLE_OVERLOADING)
    SpringAnimationInitialVelocityPropertyInfo,
#endif
    constructSpringAnimationInitialVelocity ,
    getSpringAnimationInitialVelocity       ,
    setSpringAnimationInitialVelocity       ,
#if defined(ENABLE_OVERLOADING)
    springAnimationInitialVelocity          ,
#endif


-- ** springParams #attr:springParams#
-- | Physical parameters describing the spring.

#if defined(ENABLE_OVERLOADING)
    SpringAnimationSpringParamsPropertyInfo ,
#endif
    constructSpringAnimationSpringParams    ,
    getSpringAnimationSpringParams          ,
    setSpringAnimationSpringParams          ,
#if defined(ENABLE_OVERLOADING)
    springAnimationSpringParams             ,
#endif


-- ** valueFrom #attr:valueFrom#
-- | The value to animate from.
-- 
-- The animation will start at this value and end at
-- [property/@springAnimation@/:value-to].

#if defined(ENABLE_OVERLOADING)
    SpringAnimationValueFromPropertyInfo    ,
#endif
    constructSpringAnimationValueFrom       ,
    getSpringAnimationValueFrom             ,
    setSpringAnimationValueFrom             ,
#if defined(ENABLE_OVERLOADING)
    springAnimationValueFrom                ,
#endif


-- ** valueTo #attr:valueTo#
-- | The value to animate to.
-- 
-- The animation will start at [property/@springAnimation@/:value-from] and end
-- at this value.

#if defined(ENABLE_OVERLOADING)
    SpringAnimationValueToPropertyInfo      ,
#endif
    constructSpringAnimationValueTo         ,
    getSpringAnimationValueTo               ,
    setSpringAnimationValueTo               ,
#if defined(ENABLE_OVERLOADING)
    springAnimationValueTo                  ,
#endif


-- ** velocity #attr:velocity#
-- | Current velocity of the animation.

#if defined(ENABLE_OVERLOADING)
    SpringAnimationVelocityPropertyInfo     ,
#endif
    getSpringAnimationVelocity              ,
#if defined(ENABLE_OVERLOADING)
    springAnimationVelocity                 ,
#endif




    ) where

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

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

import {-# SOURCE #-} qualified GI.Adw.Objects.Animation as Adw.Animation
import {-# SOURCE #-} qualified GI.Adw.Objects.AnimationTarget as Adw.AnimationTarget
import {-# SOURCE #-} qualified GI.Adw.Structs.SpringParams as Adw.SpringParams
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gtk.Objects.Widget as Gtk.Widget

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

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

foreign import ccall "adw_spring_animation_get_type"
    c_adw_spring_animation_get_type :: IO B.Types.GType

instance B.Types.TypedObject SpringAnimation where
    glibType :: IO GType
glibType = IO GType
c_adw_spring_animation_get_type

instance B.Types.GObject SpringAnimation

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

instance O.HasParentTypes SpringAnimation
type instance O.ParentTypes SpringAnimation = '[Adw.Animation.Animation, GObject.Object.Object]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveSpringAnimationMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveSpringAnimationMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveSpringAnimationMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveSpringAnimationMethod "calculateValue" o = SpringAnimationCalculateValueMethodInfo
    ResolveSpringAnimationMethod "calculateVelocity" o = SpringAnimationCalculateVelocityMethodInfo
    ResolveSpringAnimationMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveSpringAnimationMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveSpringAnimationMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveSpringAnimationMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveSpringAnimationMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveSpringAnimationMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveSpringAnimationMethod "pause" o = Adw.Animation.AnimationPauseMethodInfo
    ResolveSpringAnimationMethod "play" o = Adw.Animation.AnimationPlayMethodInfo
    ResolveSpringAnimationMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveSpringAnimationMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveSpringAnimationMethod "reset" o = Adw.Animation.AnimationResetMethodInfo
    ResolveSpringAnimationMethod "resume" o = Adw.Animation.AnimationResumeMethodInfo
    ResolveSpringAnimationMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveSpringAnimationMethod "skip" o = Adw.Animation.AnimationSkipMethodInfo
    ResolveSpringAnimationMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveSpringAnimationMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveSpringAnimationMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveSpringAnimationMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveSpringAnimationMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveSpringAnimationMethod "getClamp" o = SpringAnimationGetClampMethodInfo
    ResolveSpringAnimationMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveSpringAnimationMethod "getEpsilon" o = SpringAnimationGetEpsilonMethodInfo
    ResolveSpringAnimationMethod "getEstimatedDuration" o = SpringAnimationGetEstimatedDurationMethodInfo
    ResolveSpringAnimationMethod "getFollowEnableAnimationsSetting" o = Adw.Animation.AnimationGetFollowEnableAnimationsSettingMethodInfo
    ResolveSpringAnimationMethod "getInitialVelocity" o = SpringAnimationGetInitialVelocityMethodInfo
    ResolveSpringAnimationMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveSpringAnimationMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveSpringAnimationMethod "getSpringParams" o = SpringAnimationGetSpringParamsMethodInfo
    ResolveSpringAnimationMethod "getState" o = Adw.Animation.AnimationGetStateMethodInfo
    ResolveSpringAnimationMethod "getTarget" o = Adw.Animation.AnimationGetTargetMethodInfo
    ResolveSpringAnimationMethod "getValue" o = Adw.Animation.AnimationGetValueMethodInfo
    ResolveSpringAnimationMethod "getValueFrom" o = SpringAnimationGetValueFromMethodInfo
    ResolveSpringAnimationMethod "getValueTo" o = SpringAnimationGetValueToMethodInfo
    ResolveSpringAnimationMethod "getVelocity" o = SpringAnimationGetVelocityMethodInfo
    ResolveSpringAnimationMethod "getWidget" o = Adw.Animation.AnimationGetWidgetMethodInfo
    ResolveSpringAnimationMethod "setClamp" o = SpringAnimationSetClampMethodInfo
    ResolveSpringAnimationMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveSpringAnimationMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveSpringAnimationMethod "setEpsilon" o = SpringAnimationSetEpsilonMethodInfo
    ResolveSpringAnimationMethod "setFollowEnableAnimationsSetting" o = Adw.Animation.AnimationSetFollowEnableAnimationsSettingMethodInfo
    ResolveSpringAnimationMethod "setInitialVelocity" o = SpringAnimationSetInitialVelocityMethodInfo
    ResolveSpringAnimationMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveSpringAnimationMethod "setSpringParams" o = SpringAnimationSetSpringParamsMethodInfo
    ResolveSpringAnimationMethod "setTarget" o = Adw.Animation.AnimationSetTargetMethodInfo
    ResolveSpringAnimationMethod "setValueFrom" o = SpringAnimationSetValueFromMethodInfo
    ResolveSpringAnimationMethod "setValueTo" o = SpringAnimationSetValueToMethodInfo
    ResolveSpringAnimationMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "clamp"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

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

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

#if defined(ENABLE_OVERLOADING)
data SpringAnimationClampPropertyInfo
instance AttrInfo SpringAnimationClampPropertyInfo where
    type AttrAllowedOps SpringAnimationClampPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SpringAnimationClampPropertyInfo = IsSpringAnimation
    type AttrSetTypeConstraint SpringAnimationClampPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint SpringAnimationClampPropertyInfo = (~) Bool
    type AttrTransferType SpringAnimationClampPropertyInfo = Bool
    type AttrGetType SpringAnimationClampPropertyInfo = Bool
    type AttrLabel SpringAnimationClampPropertyInfo = "clamp"
    type AttrOrigin SpringAnimationClampPropertyInfo = SpringAnimation
    attrGet = getSpringAnimationClamp
    attrSet = setSpringAnimationClamp
    attrTransfer _ v = do
        return v
    attrConstruct = constructSpringAnimationClamp
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.SpringAnimation.clamp"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-SpringAnimation.html#g:attr:clamp"
        })
#endif

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

-- | Get the value of the “@epsilon@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' springAnimation #epsilon
-- @
getSpringAnimationEpsilon :: (MonadIO m, IsSpringAnimation o) => o -> m Double
getSpringAnimationEpsilon :: forall (m :: * -> *) o.
(MonadIO m, IsSpringAnimation o) =>
o -> m Double
getSpringAnimationEpsilon 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
"epsilon"

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

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

#if defined(ENABLE_OVERLOADING)
data SpringAnimationEpsilonPropertyInfo
instance AttrInfo SpringAnimationEpsilonPropertyInfo where
    type AttrAllowedOps SpringAnimationEpsilonPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SpringAnimationEpsilonPropertyInfo = IsSpringAnimation
    type AttrSetTypeConstraint SpringAnimationEpsilonPropertyInfo = (~) Double
    type AttrTransferTypeConstraint SpringAnimationEpsilonPropertyInfo = (~) Double
    type AttrTransferType SpringAnimationEpsilonPropertyInfo = Double
    type AttrGetType SpringAnimationEpsilonPropertyInfo = Double
    type AttrLabel SpringAnimationEpsilonPropertyInfo = "epsilon"
    type AttrOrigin SpringAnimationEpsilonPropertyInfo = SpringAnimation
    attrGet = getSpringAnimationEpsilon
    attrSet = setSpringAnimationEpsilon
    attrTransfer _ v = do
        return v
    attrConstruct = constructSpringAnimationEpsilon
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.SpringAnimation.epsilon"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-SpringAnimation.html#g:attr:epsilon"
        })
#endif

-- VVV Prop "estimated-duration"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

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

#if defined(ENABLE_OVERLOADING)
data SpringAnimationEstimatedDurationPropertyInfo
instance AttrInfo SpringAnimationEstimatedDurationPropertyInfo where
    type AttrAllowedOps SpringAnimationEstimatedDurationPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint SpringAnimationEstimatedDurationPropertyInfo = IsSpringAnimation
    type AttrSetTypeConstraint SpringAnimationEstimatedDurationPropertyInfo = (~) ()
    type AttrTransferTypeConstraint SpringAnimationEstimatedDurationPropertyInfo = (~) ()
    type AttrTransferType SpringAnimationEstimatedDurationPropertyInfo = ()
    type AttrGetType SpringAnimationEstimatedDurationPropertyInfo = Word32
    type AttrLabel SpringAnimationEstimatedDurationPropertyInfo = "estimated-duration"
    type AttrOrigin SpringAnimationEstimatedDurationPropertyInfo = SpringAnimation
    attrGet = getSpringAnimationEstimatedDuration
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.SpringAnimation.estimatedDuration"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-SpringAnimation.html#g:attr:estimatedDuration"
        })
#endif

-- VVV Prop "initial-velocity"
   -- Type: TBasicType TDouble
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@initial-velocity@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' springAnimation #initialVelocity
-- @
getSpringAnimationInitialVelocity :: (MonadIO m, IsSpringAnimation o) => o -> m Double
getSpringAnimationInitialVelocity :: forall (m :: * -> *) o.
(MonadIO m, IsSpringAnimation o) =>
o -> m Double
getSpringAnimationInitialVelocity 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
"initial-velocity"

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

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

#if defined(ENABLE_OVERLOADING)
data SpringAnimationInitialVelocityPropertyInfo
instance AttrInfo SpringAnimationInitialVelocityPropertyInfo where
    type AttrAllowedOps SpringAnimationInitialVelocityPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SpringAnimationInitialVelocityPropertyInfo = IsSpringAnimation
    type AttrSetTypeConstraint SpringAnimationInitialVelocityPropertyInfo = (~) Double
    type AttrTransferTypeConstraint SpringAnimationInitialVelocityPropertyInfo = (~) Double
    type AttrTransferType SpringAnimationInitialVelocityPropertyInfo = Double
    type AttrGetType SpringAnimationInitialVelocityPropertyInfo = Double
    type AttrLabel SpringAnimationInitialVelocityPropertyInfo = "initial-velocity"
    type AttrOrigin SpringAnimationInitialVelocityPropertyInfo = SpringAnimation
    attrGet = getSpringAnimationInitialVelocity
    attrSet = setSpringAnimationInitialVelocity
    attrTransfer _ v = do
        return v
    attrConstruct = constructSpringAnimationInitialVelocity
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.SpringAnimation.initialVelocity"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-SpringAnimation.html#g:attr:initialVelocity"
        })
#endif

-- VVV Prop "spring-params"
   -- Type: TInterface (Name {namespace = "Adw", name = "SpringParams"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@spring-params@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' springAnimation #springParams
-- @
getSpringAnimationSpringParams :: (MonadIO m, IsSpringAnimation o) => o -> m Adw.SpringParams.SpringParams
getSpringAnimationSpringParams :: forall (m :: * -> *) o.
(MonadIO m, IsSpringAnimation o) =>
o -> m SpringParams
getSpringAnimationSpringParams o
obj = IO SpringParams -> m SpringParams
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO SpringParams -> m SpringParams)
-> IO SpringParams -> m SpringParams
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe SpringParams) -> IO SpringParams
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getSpringAnimationSpringParams" (IO (Maybe SpringParams) -> IO SpringParams)
-> IO (Maybe SpringParams) -> IO SpringParams
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr SpringParams -> SpringParams)
-> IO (Maybe SpringParams)
forall a b.
(GObject a, GBoxed b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyBoxed o
obj String
"spring-params" ManagedPtr SpringParams -> SpringParams
Adw.SpringParams.SpringParams

-- | Set the value of the “@spring-params@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' springAnimation [ #springParams 'Data.GI.Base.Attributes.:=' value ]
-- @
setSpringAnimationSpringParams :: (MonadIO m, IsSpringAnimation o) => o -> Adw.SpringParams.SpringParams -> m ()
setSpringAnimationSpringParams :: forall (m :: * -> *) o.
(MonadIO m, IsSpringAnimation o) =>
o -> SpringParams -> m ()
setSpringAnimationSpringParams o
obj SpringParams
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 SpringParams -> IO ()
forall a b.
(GObject a, GBoxed b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyBoxed o
obj String
"spring-params" (SpringParams -> Maybe SpringParams
forall a. a -> Maybe a
Just SpringParams
val)

-- | Construct a `GValueConstruct` with valid value for the “@spring-params@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSpringAnimationSpringParams :: (IsSpringAnimation o, MIO.MonadIO m) => Adw.SpringParams.SpringParams -> m (GValueConstruct o)
constructSpringAnimationSpringParams :: forall o (m :: * -> *).
(IsSpringAnimation o, MonadIO m) =>
SpringParams -> m (GValueConstruct o)
constructSpringAnimationSpringParams SpringParams
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 SpringParams -> IO (GValueConstruct o)
forall a o. GBoxed a => String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBoxed String
"spring-params" (SpringParams -> Maybe SpringParams
forall a. a -> Maybe a
P.Just SpringParams
val)

#if defined(ENABLE_OVERLOADING)
data SpringAnimationSpringParamsPropertyInfo
instance AttrInfo SpringAnimationSpringParamsPropertyInfo where
    type AttrAllowedOps SpringAnimationSpringParamsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SpringAnimationSpringParamsPropertyInfo = IsSpringAnimation
    type AttrSetTypeConstraint SpringAnimationSpringParamsPropertyInfo = (~) Adw.SpringParams.SpringParams
    type AttrTransferTypeConstraint SpringAnimationSpringParamsPropertyInfo = (~) Adw.SpringParams.SpringParams
    type AttrTransferType SpringAnimationSpringParamsPropertyInfo = Adw.SpringParams.SpringParams
    type AttrGetType SpringAnimationSpringParamsPropertyInfo = Adw.SpringParams.SpringParams
    type AttrLabel SpringAnimationSpringParamsPropertyInfo = "spring-params"
    type AttrOrigin SpringAnimationSpringParamsPropertyInfo = SpringAnimation
    attrGet = getSpringAnimationSpringParams
    attrSet = setSpringAnimationSpringParams
    attrTransfer _ v = do
        return v
    attrConstruct = constructSpringAnimationSpringParams
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.SpringAnimation.springParams"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-SpringAnimation.html#g:attr:springParams"
        })
#endif

-- VVV Prop "value-from"
   -- Type: TBasicType TDouble
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@value-from@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' springAnimation #valueFrom
-- @
getSpringAnimationValueFrom :: (MonadIO m, IsSpringAnimation o) => o -> m Double
getSpringAnimationValueFrom :: forall (m :: * -> *) o.
(MonadIO m, IsSpringAnimation o) =>
o -> m Double
getSpringAnimationValueFrom 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
"value-from"

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

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

#if defined(ENABLE_OVERLOADING)
data SpringAnimationValueFromPropertyInfo
instance AttrInfo SpringAnimationValueFromPropertyInfo where
    type AttrAllowedOps SpringAnimationValueFromPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SpringAnimationValueFromPropertyInfo = IsSpringAnimation
    type AttrSetTypeConstraint SpringAnimationValueFromPropertyInfo = (~) Double
    type AttrTransferTypeConstraint SpringAnimationValueFromPropertyInfo = (~) Double
    type AttrTransferType SpringAnimationValueFromPropertyInfo = Double
    type AttrGetType SpringAnimationValueFromPropertyInfo = Double
    type AttrLabel SpringAnimationValueFromPropertyInfo = "value-from"
    type AttrOrigin SpringAnimationValueFromPropertyInfo = SpringAnimation
    attrGet = getSpringAnimationValueFrom
    attrSet = setSpringAnimationValueFrom
    attrTransfer _ v = do
        return v
    attrConstruct = constructSpringAnimationValueFrom
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.SpringAnimation.valueFrom"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-SpringAnimation.html#g:attr:valueFrom"
        })
#endif

-- VVV Prop "value-to"
   -- Type: TBasicType TDouble
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@value-to@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' springAnimation #valueTo
-- @
getSpringAnimationValueTo :: (MonadIO m, IsSpringAnimation o) => o -> m Double
getSpringAnimationValueTo :: forall (m :: * -> *) o.
(MonadIO m, IsSpringAnimation o) =>
o -> m Double
getSpringAnimationValueTo 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
"value-to"

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

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

#if defined(ENABLE_OVERLOADING)
data SpringAnimationValueToPropertyInfo
instance AttrInfo SpringAnimationValueToPropertyInfo where
    type AttrAllowedOps SpringAnimationValueToPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SpringAnimationValueToPropertyInfo = IsSpringAnimation
    type AttrSetTypeConstraint SpringAnimationValueToPropertyInfo = (~) Double
    type AttrTransferTypeConstraint SpringAnimationValueToPropertyInfo = (~) Double
    type AttrTransferType SpringAnimationValueToPropertyInfo = Double
    type AttrGetType SpringAnimationValueToPropertyInfo = Double
    type AttrLabel SpringAnimationValueToPropertyInfo = "value-to"
    type AttrOrigin SpringAnimationValueToPropertyInfo = SpringAnimation
    attrGet = getSpringAnimationValueTo
    attrSet = setSpringAnimationValueTo
    attrTransfer _ v = do
        return v
    attrConstruct = constructSpringAnimationValueTo
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.SpringAnimation.valueTo"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-SpringAnimation.html#g:attr:valueTo"
        })
#endif

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

-- | Get the value of the “@velocity@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' springAnimation #velocity
-- @
getSpringAnimationVelocity :: (MonadIO m, IsSpringAnimation o) => o -> m Double
getSpringAnimationVelocity :: forall (m :: * -> *) o.
(MonadIO m, IsSpringAnimation o) =>
o -> m Double
getSpringAnimationVelocity 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
"velocity"

#if defined(ENABLE_OVERLOADING)
data SpringAnimationVelocityPropertyInfo
instance AttrInfo SpringAnimationVelocityPropertyInfo where
    type AttrAllowedOps SpringAnimationVelocityPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint SpringAnimationVelocityPropertyInfo = IsSpringAnimation
    type AttrSetTypeConstraint SpringAnimationVelocityPropertyInfo = (~) ()
    type AttrTransferTypeConstraint SpringAnimationVelocityPropertyInfo = (~) ()
    type AttrTransferType SpringAnimationVelocityPropertyInfo = ()
    type AttrGetType SpringAnimationVelocityPropertyInfo = Double
    type AttrLabel SpringAnimationVelocityPropertyInfo = "velocity"
    type AttrOrigin SpringAnimationVelocityPropertyInfo = SpringAnimation
    attrGet = getSpringAnimationVelocity
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.SpringAnimation.velocity"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-SpringAnimation.html#g:attr:velocity"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList SpringAnimation
type instance O.AttributeList SpringAnimation = SpringAnimationAttributeList
type SpringAnimationAttributeList = ('[ '("clamp", SpringAnimationClampPropertyInfo), '("epsilon", SpringAnimationEpsilonPropertyInfo), '("estimatedDuration", SpringAnimationEstimatedDurationPropertyInfo), '("followEnableAnimationsSetting", Adw.Animation.AnimationFollowEnableAnimationsSettingPropertyInfo), '("initialVelocity", SpringAnimationInitialVelocityPropertyInfo), '("springParams", SpringAnimationSpringParamsPropertyInfo), '("state", Adw.Animation.AnimationStatePropertyInfo), '("target", Adw.Animation.AnimationTargetPropertyInfo), '("value", Adw.Animation.AnimationValuePropertyInfo), '("valueFrom", SpringAnimationValueFromPropertyInfo), '("valueTo", SpringAnimationValueToPropertyInfo), '("velocity", SpringAnimationVelocityPropertyInfo), '("widget", Adw.Animation.AnimationWidgetPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
springAnimationClamp :: AttrLabelProxy "clamp"
springAnimationClamp = AttrLabelProxy

springAnimationEpsilon :: AttrLabelProxy "epsilon"
springAnimationEpsilon = AttrLabelProxy

springAnimationEstimatedDuration :: AttrLabelProxy "estimatedDuration"
springAnimationEstimatedDuration = AttrLabelProxy

springAnimationInitialVelocity :: AttrLabelProxy "initialVelocity"
springAnimationInitialVelocity = AttrLabelProxy

springAnimationSpringParams :: AttrLabelProxy "springParams"
springAnimationSpringParams = AttrLabelProxy

springAnimationValueFrom :: AttrLabelProxy "valueFrom"
springAnimationValueFrom = AttrLabelProxy

springAnimationValueTo :: AttrLabelProxy "valueTo"
springAnimationValueTo = AttrLabelProxy

springAnimationVelocity :: AttrLabelProxy "velocity"
springAnimationVelocity = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList SpringAnimation = SpringAnimationSignalList
type SpringAnimationSignalList = ('[ '("done", Adw.Animation.AnimationDoneSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method SpringAnimation::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "widget"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a widget to create animation on"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "from"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a value to animate from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "to"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a value to animate to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "spring_params"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "SpringParams" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "physical parameters of the spring"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "target"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "AnimationTarget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a target value to animate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Adw" , name = "SpringAnimation" })
-- throws : False
-- Skip return : False

foreign import ccall "adw_spring_animation_new" adw_spring_animation_new :: 
    Ptr Gtk.Widget.Widget ->                -- widget : TInterface (Name {namespace = "Gtk", name = "Widget"})
    CDouble ->                              -- from : TBasicType TDouble
    CDouble ->                              -- to : TBasicType TDouble
    Ptr Adw.SpringParams.SpringParams ->    -- spring_params : TInterface (Name {namespace = "Adw", name = "SpringParams"})
    Ptr Adw.AnimationTarget.AnimationTarget -> -- target : TInterface (Name {namespace = "Adw", name = "AnimationTarget"})
    IO (Ptr SpringAnimation)

-- | Creates a new @AdwSpringAnimation@ on /@widget@/.
-- 
-- The animation will animate /@target@/ from /@from@/ to /@to@/ with the dynamics of a
-- spring described by /@springParams@/.
springAnimationNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gtk.Widget.IsWidget a, Adw.AnimationTarget.IsAnimationTarget b) =>
    a
    -- ^ /@widget@/: a widget to create animation on
    -> Double
    -- ^ /@from@/: a value to animate from
    -> Double
    -- ^ /@to@/: a value to animate to
    -> Adw.SpringParams.SpringParams
    -- ^ /@springParams@/: physical parameters of the spring
    -> b
    -- ^ /@target@/: a target value to animate
    -> m SpringAnimation
    -- ^ __Returns:__ the newly created animation
springAnimationNew :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsWidget a, IsAnimationTarget b) =>
a -> Double -> Double -> SpringParams -> b -> m SpringAnimation
springAnimationNew a
widget Double
from Double
to SpringParams
springParams b
target = IO SpringAnimation -> m SpringAnimation
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SpringAnimation -> m SpringAnimation)
-> IO SpringAnimation -> m SpringAnimation
forall a b. (a -> b) -> a -> b
$ do
    Ptr Widget
widget' <- a -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
widget
    let from' :: CDouble
from' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
from
    let to' :: CDouble
to' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
to
    Ptr SpringParams
springParams' <- SpringParams -> IO (Ptr SpringParams)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed SpringParams
springParams
    Ptr AnimationTarget
target' <- b -> IO (Ptr AnimationTarget)
forall a b. (HasCallStack, GObject a) => a -> IO (Ptr b)
B.ManagedPtr.disownObject b
target
    Ptr SpringAnimation
result <- Ptr Widget
-> CDouble
-> CDouble
-> Ptr SpringParams
-> Ptr AnimationTarget
-> IO (Ptr SpringAnimation)
adw_spring_animation_new Ptr Widget
widget' CDouble
from' CDouble
to' Ptr SpringParams
springParams' Ptr AnimationTarget
target'
    Text -> Ptr SpringAnimation -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"springAnimationNew" Ptr SpringAnimation
result
    SpringAnimation
result' <- ((ManagedPtr SpringAnimation -> SpringAnimation)
-> Ptr SpringAnimation -> IO SpringAnimation
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr SpringAnimation -> SpringAnimation
SpringAnimation) Ptr SpringAnimation
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
widget
    SpringParams -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr SpringParams
springParams
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
target
    SpringAnimation -> IO SpringAnimation
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SpringAnimation
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method SpringAnimation::calculate_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "SpringAnimation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a spring animation" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "time"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "elapsed time, in milliseconds"
--                 , 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 "adw_spring_animation_calculate_value" adw_spring_animation_calculate_value :: 
    Ptr SpringAnimation ->                  -- self : TInterface (Name {namespace = "Adw", name = "SpringAnimation"})
    Word32 ->                               -- time : TBasicType TUInt
    IO CDouble

-- | Calculates the value /@self@/ will have at /@time@/.
-- 
-- The time starts at 0 and ends at
-- [property/@springAnimation@/:estimated_duration].
-- 
-- See also [method/@springAnimation@/.calculate_velocity].
-- 
-- /Since: 1.3/
springAnimationCalculateValue ::
    (B.CallStack.HasCallStack, MonadIO m, IsSpringAnimation a) =>
    a
    -- ^ /@self@/: a spring animation
    -> Word32
    -- ^ /@time@/: elapsed time, in milliseconds
    -> m Double
    -- ^ __Returns:__ the value at /@time@/
springAnimationCalculateValue :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSpringAnimation a) =>
a -> Word32 -> m Double
springAnimationCalculateValue a
self Word32
time = 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 SpringAnimation
self' <- a -> IO (Ptr SpringAnimation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CDouble
result <- Ptr SpringAnimation -> Word32 -> IO CDouble
adw_spring_animation_calculate_value Ptr SpringAnimation
self' Word32
time
    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
self
    Double -> IO Double
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data SpringAnimationCalculateValueMethodInfo
instance (signature ~ (Word32 -> m Double), MonadIO m, IsSpringAnimation a) => O.OverloadedMethod SpringAnimationCalculateValueMethodInfo a signature where
    overloadedMethod = springAnimationCalculateValue

instance O.OverloadedMethodInfo SpringAnimationCalculateValueMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.SpringAnimation.springAnimationCalculateValue",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-SpringAnimation.html#v:springAnimationCalculateValue"
        })


#endif

-- method SpringAnimation::calculate_velocity
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "SpringAnimation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a spring animation" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "time"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "elapsed time, in milliseconds"
--                 , 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 "adw_spring_animation_calculate_velocity" adw_spring_animation_calculate_velocity :: 
    Ptr SpringAnimation ->                  -- self : TInterface (Name {namespace = "Adw", name = "SpringAnimation"})
    Word32 ->                               -- time : TBasicType TUInt
    IO CDouble

-- | Calculates the velocity /@self@/ will have at /@time@/.
-- 
-- The time starts at 0 and ends at
-- [property/@springAnimation@/:estimated_duration].
-- 
-- See also [method/@springAnimation@/.calculate_value].
-- 
-- /Since: 1.3/
springAnimationCalculateVelocity ::
    (B.CallStack.HasCallStack, MonadIO m, IsSpringAnimation a) =>
    a
    -- ^ /@self@/: a spring animation
    -> Word32
    -- ^ /@time@/: elapsed time, in milliseconds
    -> m Double
    -- ^ __Returns:__ the velocity at /@time@/
springAnimationCalculateVelocity :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSpringAnimation a) =>
a -> Word32 -> m Double
springAnimationCalculateVelocity a
self Word32
time = 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 SpringAnimation
self' <- a -> IO (Ptr SpringAnimation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CDouble
result <- Ptr SpringAnimation -> Word32 -> IO CDouble
adw_spring_animation_calculate_velocity Ptr SpringAnimation
self' Word32
time
    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
self
    Double -> IO Double
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data SpringAnimationCalculateVelocityMethodInfo
instance (signature ~ (Word32 -> m Double), MonadIO m, IsSpringAnimation a) => O.OverloadedMethod SpringAnimationCalculateVelocityMethodInfo a signature where
    overloadedMethod = springAnimationCalculateVelocity

instance O.OverloadedMethodInfo SpringAnimationCalculateVelocityMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.SpringAnimation.springAnimationCalculateVelocity",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-SpringAnimation.html#v:springAnimationCalculateVelocity"
        })


#endif

-- method SpringAnimation::get_clamp
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "SpringAnimation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a spring animation" , 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 "adw_spring_animation_get_clamp" adw_spring_animation_get_clamp :: 
    Ptr SpringAnimation ->                  -- self : TInterface (Name {namespace = "Adw", name = "SpringAnimation"})
    IO CInt

-- | Gets whether /@self@/ should be clamped.
springAnimationGetClamp ::
    (B.CallStack.HasCallStack, MonadIO m, IsSpringAnimation a) =>
    a
    -- ^ /@self@/: a spring animation
    -> m Bool
    -- ^ __Returns:__ whether /@self@/ is clamped
springAnimationGetClamp :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSpringAnimation a) =>
a -> m Bool
springAnimationGetClamp a
self = 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 SpringAnimation
self' <- a -> IO (Ptr SpringAnimation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr SpringAnimation -> IO CInt
adw_spring_animation_get_clamp Ptr SpringAnimation
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SpringAnimationGetClampMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsSpringAnimation a) => O.OverloadedMethod SpringAnimationGetClampMethodInfo a signature where
    overloadedMethod = springAnimationGetClamp

instance O.OverloadedMethodInfo SpringAnimationGetClampMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.SpringAnimation.springAnimationGetClamp",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-SpringAnimation.html#v:springAnimationGetClamp"
        })


#endif

-- method SpringAnimation::get_epsilon
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "SpringAnimation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a spring animation" , 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 "adw_spring_animation_get_epsilon" adw_spring_animation_get_epsilon :: 
    Ptr SpringAnimation ->                  -- self : TInterface (Name {namespace = "Adw", name = "SpringAnimation"})
    IO CDouble

-- | Gets the precision of the spring.
springAnimationGetEpsilon ::
    (B.CallStack.HasCallStack, MonadIO m, IsSpringAnimation a) =>
    a
    -- ^ /@self@/: a spring animation
    -> m Double
    -- ^ __Returns:__ the epsilon value
springAnimationGetEpsilon :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSpringAnimation a) =>
a -> m Double
springAnimationGetEpsilon a
self = 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 SpringAnimation
self' <- a -> IO (Ptr SpringAnimation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CDouble
result <- Ptr SpringAnimation -> IO CDouble
adw_spring_animation_get_epsilon Ptr SpringAnimation
self'
    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
self
    Double -> IO Double
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data SpringAnimationGetEpsilonMethodInfo
instance (signature ~ (m Double), MonadIO m, IsSpringAnimation a) => O.OverloadedMethod SpringAnimationGetEpsilonMethodInfo a signature where
    overloadedMethod = springAnimationGetEpsilon

instance O.OverloadedMethodInfo SpringAnimationGetEpsilonMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.SpringAnimation.springAnimationGetEpsilon",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-SpringAnimation.html#v:springAnimationGetEpsilon"
        })


#endif

-- method SpringAnimation::get_estimated_duration
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "SpringAnimation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a spring animation" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "adw_spring_animation_get_estimated_duration" adw_spring_animation_get_estimated_duration :: 
    Ptr SpringAnimation ->                  -- self : TInterface (Name {namespace = "Adw", name = "SpringAnimation"})
    IO Word32

-- | Gets the estimated duration of /@self@/, in milliseconds.
-- 
-- Can be [const/@dURATIONINFINITE@/] if the spring damping is set to 0.
springAnimationGetEstimatedDuration ::
    (B.CallStack.HasCallStack, MonadIO m, IsSpringAnimation a) =>
    a
    -- ^ /@self@/: a spring animation
    -> m Word32
    -- ^ __Returns:__ the estimated duration
springAnimationGetEstimatedDuration :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSpringAnimation a) =>
a -> m Word32
springAnimationGetEstimatedDuration a
self = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr SpringAnimation
self' <- a -> IO (Ptr SpringAnimation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Word32
result <- Ptr SpringAnimation -> IO Word32
adw_spring_animation_get_estimated_duration Ptr SpringAnimation
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data SpringAnimationGetEstimatedDurationMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsSpringAnimation a) => O.OverloadedMethod SpringAnimationGetEstimatedDurationMethodInfo a signature where
    overloadedMethod = springAnimationGetEstimatedDuration

instance O.OverloadedMethodInfo SpringAnimationGetEstimatedDurationMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.SpringAnimation.springAnimationGetEstimatedDuration",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-SpringAnimation.html#v:springAnimationGetEstimatedDuration"
        })


#endif

-- method SpringAnimation::get_initial_velocity
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "SpringAnimation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a spring animation" , 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 "adw_spring_animation_get_initial_velocity" adw_spring_animation_get_initial_velocity :: 
    Ptr SpringAnimation ->                  -- self : TInterface (Name {namespace = "Adw", name = "SpringAnimation"})
    IO CDouble

-- | Gets the initial velocity of /@self@/.
springAnimationGetInitialVelocity ::
    (B.CallStack.HasCallStack, MonadIO m, IsSpringAnimation a) =>
    a
    -- ^ /@self@/: a spring animation
    -> m Double
    -- ^ __Returns:__ the initial velocity
springAnimationGetInitialVelocity :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSpringAnimation a) =>
a -> m Double
springAnimationGetInitialVelocity a
self = 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 SpringAnimation
self' <- a -> IO (Ptr SpringAnimation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CDouble
result <- Ptr SpringAnimation -> IO CDouble
adw_spring_animation_get_initial_velocity Ptr SpringAnimation
self'
    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
self
    Double -> IO Double
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data SpringAnimationGetInitialVelocityMethodInfo
instance (signature ~ (m Double), MonadIO m, IsSpringAnimation a) => O.OverloadedMethod SpringAnimationGetInitialVelocityMethodInfo a signature where
    overloadedMethod = springAnimationGetInitialVelocity

instance O.OverloadedMethodInfo SpringAnimationGetInitialVelocityMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.SpringAnimation.springAnimationGetInitialVelocity",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-SpringAnimation.html#v:springAnimationGetInitialVelocity"
        })


#endif

-- method SpringAnimation::get_spring_params
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "SpringAnimation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a spring animation" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Adw" , name = "SpringParams" })
-- throws : False
-- Skip return : False

foreign import ccall "adw_spring_animation_get_spring_params" adw_spring_animation_get_spring_params :: 
    Ptr SpringAnimation ->                  -- self : TInterface (Name {namespace = "Adw", name = "SpringAnimation"})
    IO (Ptr Adw.SpringParams.SpringParams)

-- | Gets the physical parameters of the spring of /@self@/.
springAnimationGetSpringParams ::
    (B.CallStack.HasCallStack, MonadIO m, IsSpringAnimation a) =>
    a
    -- ^ /@self@/: a spring animation
    -> m Adw.SpringParams.SpringParams
    -- ^ __Returns:__ the spring parameters
springAnimationGetSpringParams :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSpringAnimation a) =>
a -> m SpringParams
springAnimationGetSpringParams a
self = IO SpringParams -> m SpringParams
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SpringParams -> m SpringParams)
-> IO SpringParams -> m SpringParams
forall a b. (a -> b) -> a -> b
$ do
    Ptr SpringAnimation
self' <- a -> IO (Ptr SpringAnimation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr SpringParams
result <- Ptr SpringAnimation -> IO (Ptr SpringParams)
adw_spring_animation_get_spring_params Ptr SpringAnimation
self'
    Text -> Ptr SpringParams -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"springAnimationGetSpringParams" Ptr SpringParams
result
    SpringParams
result' <- ((ManagedPtr SpringParams -> SpringParams)
-> Ptr SpringParams -> IO SpringParams
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr SpringParams -> SpringParams
Adw.SpringParams.SpringParams) Ptr SpringParams
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    SpringParams -> IO SpringParams
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SpringParams
result'

#if defined(ENABLE_OVERLOADING)
data SpringAnimationGetSpringParamsMethodInfo
instance (signature ~ (m Adw.SpringParams.SpringParams), MonadIO m, IsSpringAnimation a) => O.OverloadedMethod SpringAnimationGetSpringParamsMethodInfo a signature where
    overloadedMethod = springAnimationGetSpringParams

instance O.OverloadedMethodInfo SpringAnimationGetSpringParamsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.SpringAnimation.springAnimationGetSpringParams",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-SpringAnimation.html#v:springAnimationGetSpringParams"
        })


#endif

-- method SpringAnimation::get_value_from
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "SpringAnimation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a spring animation" , 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 "adw_spring_animation_get_value_from" adw_spring_animation_get_value_from :: 
    Ptr SpringAnimation ->                  -- self : TInterface (Name {namespace = "Adw", name = "SpringAnimation"})
    IO CDouble

-- | Gets the value /@self@/ will animate from.
springAnimationGetValueFrom ::
    (B.CallStack.HasCallStack, MonadIO m, IsSpringAnimation a) =>
    a
    -- ^ /@self@/: a spring animation
    -> m Double
    -- ^ __Returns:__ the value to animate from
springAnimationGetValueFrom :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSpringAnimation a) =>
a -> m Double
springAnimationGetValueFrom a
self = 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 SpringAnimation
self' <- a -> IO (Ptr SpringAnimation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CDouble
result <- Ptr SpringAnimation -> IO CDouble
adw_spring_animation_get_value_from Ptr SpringAnimation
self'
    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
self
    Double -> IO Double
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data SpringAnimationGetValueFromMethodInfo
instance (signature ~ (m Double), MonadIO m, IsSpringAnimation a) => O.OverloadedMethod SpringAnimationGetValueFromMethodInfo a signature where
    overloadedMethod = springAnimationGetValueFrom

instance O.OverloadedMethodInfo SpringAnimationGetValueFromMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.SpringAnimation.springAnimationGetValueFrom",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-SpringAnimation.html#v:springAnimationGetValueFrom"
        })


#endif

-- method SpringAnimation::get_value_to
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "SpringAnimation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a spring animation" , 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 "adw_spring_animation_get_value_to" adw_spring_animation_get_value_to :: 
    Ptr SpringAnimation ->                  -- self : TInterface (Name {namespace = "Adw", name = "SpringAnimation"})
    IO CDouble

-- | Gets the value /@self@/ will animate to.
springAnimationGetValueTo ::
    (B.CallStack.HasCallStack, MonadIO m, IsSpringAnimation a) =>
    a
    -- ^ /@self@/: a spring animation
    -> m Double
    -- ^ __Returns:__ the value to animate to
springAnimationGetValueTo :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSpringAnimation a) =>
a -> m Double
springAnimationGetValueTo a
self = 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 SpringAnimation
self' <- a -> IO (Ptr SpringAnimation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CDouble
result <- Ptr SpringAnimation -> IO CDouble
adw_spring_animation_get_value_to Ptr SpringAnimation
self'
    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
self
    Double -> IO Double
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data SpringAnimationGetValueToMethodInfo
instance (signature ~ (m Double), MonadIO m, IsSpringAnimation a) => O.OverloadedMethod SpringAnimationGetValueToMethodInfo a signature where
    overloadedMethod = springAnimationGetValueTo

instance O.OverloadedMethodInfo SpringAnimationGetValueToMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.SpringAnimation.springAnimationGetValueTo",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-SpringAnimation.html#v:springAnimationGetValueTo"
        })


#endif

-- method SpringAnimation::get_velocity
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "SpringAnimation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a spring animation" , 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 "adw_spring_animation_get_velocity" adw_spring_animation_get_velocity :: 
    Ptr SpringAnimation ->                  -- self : TInterface (Name {namespace = "Adw", name = "SpringAnimation"})
    IO CDouble

-- | Gets the current velocity of /@self@/.
springAnimationGetVelocity ::
    (B.CallStack.HasCallStack, MonadIO m, IsSpringAnimation a) =>
    a
    -- ^ /@self@/: a spring animation
    -> m Double
    -- ^ __Returns:__ the current velocity
springAnimationGetVelocity :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSpringAnimation a) =>
a -> m Double
springAnimationGetVelocity a
self = 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 SpringAnimation
self' <- a -> IO (Ptr SpringAnimation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CDouble
result <- Ptr SpringAnimation -> IO CDouble
adw_spring_animation_get_velocity Ptr SpringAnimation
self'
    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
self
    Double -> IO Double
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data SpringAnimationGetVelocityMethodInfo
instance (signature ~ (m Double), MonadIO m, IsSpringAnimation a) => O.OverloadedMethod SpringAnimationGetVelocityMethodInfo a signature where
    overloadedMethod = springAnimationGetVelocity

instance O.OverloadedMethodInfo SpringAnimationGetVelocityMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.SpringAnimation.springAnimationGetVelocity",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-SpringAnimation.html#v:springAnimationGetVelocity"
        })


#endif

-- method SpringAnimation::set_clamp
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "SpringAnimation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a spring animation" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "clamp"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "adw_spring_animation_set_clamp" adw_spring_animation_set_clamp :: 
    Ptr SpringAnimation ->                  -- self : TInterface (Name {namespace = "Adw", name = "SpringAnimation"})
    CInt ->                                 -- clamp : TBasicType TBoolean
    IO ()

-- | Sets whether /@self@/ should be clamped.
-- 
-- If set to @TRUE@, the animation will abruptly end as soon as it reaches the
-- final value, preventing overshooting.
-- 
-- It won\'t prevent overshooting [property/@springAnimation@/:value-from] if a
-- relative negative [property/@springAnimation@/:initial-velocity] is set.
springAnimationSetClamp ::
    (B.CallStack.HasCallStack, MonadIO m, IsSpringAnimation a) =>
    a
    -- ^ /@self@/: a spring animation
    -> Bool
    -- ^ /@clamp@/: the new value
    -> m ()
springAnimationSetClamp :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSpringAnimation a) =>
a -> Bool -> m ()
springAnimationSetClamp a
self Bool
clamp = 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 SpringAnimation
self' <- a -> IO (Ptr SpringAnimation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let clamp' :: CInt
clamp' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
clamp
    Ptr SpringAnimation -> CInt -> IO ()
adw_spring_animation_set_clamp Ptr SpringAnimation
self' CInt
clamp'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SpringAnimationSetClampMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsSpringAnimation a) => O.OverloadedMethod SpringAnimationSetClampMethodInfo a signature where
    overloadedMethod = springAnimationSetClamp

instance O.OverloadedMethodInfo SpringAnimationSetClampMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.SpringAnimation.springAnimationSetClamp",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-SpringAnimation.html#v:springAnimationSetClamp"
        })


#endif

-- method SpringAnimation::set_epsilon
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "SpringAnimation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a spring animation" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "epsilon"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "adw_spring_animation_set_epsilon" adw_spring_animation_set_epsilon :: 
    Ptr SpringAnimation ->                  -- self : TInterface (Name {namespace = "Adw", name = "SpringAnimation"})
    CDouble ->                              -- epsilon : TBasicType TDouble
    IO ()

-- | Sets the precision of the spring.
-- 
-- The level of precision used to determine when the animation has come to a
-- rest, that is, when the amplitude of the oscillations becomes smaller than
-- this value.
-- 
-- If the epsilon value is too small, the animation will take a long time to
-- stop after the animated value has stopped visibly changing.
-- 
-- If the epsilon value is too large, the animation will end prematurely.
-- 
-- The default value is 0.001.
springAnimationSetEpsilon ::
    (B.CallStack.HasCallStack, MonadIO m, IsSpringAnimation a) =>
    a
    -- ^ /@self@/: a spring animation
    -> Double
    -- ^ /@epsilon@/: the new value
    -> m ()
springAnimationSetEpsilon :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSpringAnimation a) =>
a -> Double -> m ()
springAnimationSetEpsilon a
self Double
epsilon = 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 SpringAnimation
self' <- a -> IO (Ptr SpringAnimation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let epsilon' :: CDouble
epsilon' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
epsilon
    Ptr SpringAnimation -> CDouble -> IO ()
adw_spring_animation_set_epsilon Ptr SpringAnimation
self' CDouble
epsilon'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SpringAnimationSetEpsilonMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m, IsSpringAnimation a) => O.OverloadedMethod SpringAnimationSetEpsilonMethodInfo a signature where
    overloadedMethod = springAnimationSetEpsilon

instance O.OverloadedMethodInfo SpringAnimationSetEpsilonMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.SpringAnimation.springAnimationSetEpsilon",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-SpringAnimation.html#v:springAnimationSetEpsilon"
        })


#endif

-- method SpringAnimation::set_initial_velocity
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "SpringAnimation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a spring animation" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "velocity"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the initial velocity"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "adw_spring_animation_set_initial_velocity" adw_spring_animation_set_initial_velocity :: 
    Ptr SpringAnimation ->                  -- self : TInterface (Name {namespace = "Adw", name = "SpringAnimation"})
    CDouble ->                              -- velocity : TBasicType TDouble
    IO ()

-- | Sets the initial velocity of /@self@/.
-- 
-- Initial velocity affects only the animation curve, but not its duration.
springAnimationSetInitialVelocity ::
    (B.CallStack.HasCallStack, MonadIO m, IsSpringAnimation a) =>
    a
    -- ^ /@self@/: a spring animation
    -> Double
    -- ^ /@velocity@/: the initial velocity
    -> m ()
springAnimationSetInitialVelocity :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSpringAnimation a) =>
a -> Double -> m ()
springAnimationSetInitialVelocity a
self Double
velocity = 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 SpringAnimation
self' <- a -> IO (Ptr SpringAnimation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let velocity' :: CDouble
velocity' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
velocity
    Ptr SpringAnimation -> CDouble -> IO ()
adw_spring_animation_set_initial_velocity Ptr SpringAnimation
self' CDouble
velocity'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SpringAnimationSetInitialVelocityMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m, IsSpringAnimation a) => O.OverloadedMethod SpringAnimationSetInitialVelocityMethodInfo a signature where
    overloadedMethod = springAnimationSetInitialVelocity

instance O.OverloadedMethodInfo SpringAnimationSetInitialVelocityMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.SpringAnimation.springAnimationSetInitialVelocity",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-SpringAnimation.html#v:springAnimationSetInitialVelocity"
        })


#endif

-- method SpringAnimation::set_spring_params
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "SpringAnimation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a spring animation" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "spring_params"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "SpringParams" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new spring parameters"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "adw_spring_animation_set_spring_params" adw_spring_animation_set_spring_params :: 
    Ptr SpringAnimation ->                  -- self : TInterface (Name {namespace = "Adw", name = "SpringAnimation"})
    Ptr Adw.SpringParams.SpringParams ->    -- spring_params : TInterface (Name {namespace = "Adw", name = "SpringParams"})
    IO ()

-- | Sets the physical parameters of the spring of /@self@/.
springAnimationSetSpringParams ::
    (B.CallStack.HasCallStack, MonadIO m, IsSpringAnimation a) =>
    a
    -- ^ /@self@/: a spring animation
    -> Adw.SpringParams.SpringParams
    -- ^ /@springParams@/: the new spring parameters
    -> m ()
springAnimationSetSpringParams :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSpringAnimation a) =>
a -> SpringParams -> m ()
springAnimationSetSpringParams a
self SpringParams
springParams = 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 SpringAnimation
self' <- a -> IO (Ptr SpringAnimation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr SpringParams
springParams' <- SpringParams -> IO (Ptr SpringParams)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SpringParams
springParams
    Ptr SpringAnimation -> Ptr SpringParams -> IO ()
adw_spring_animation_set_spring_params Ptr SpringAnimation
self' Ptr SpringParams
springParams'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    SpringParams -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr SpringParams
springParams
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SpringAnimationSetSpringParamsMethodInfo
instance (signature ~ (Adw.SpringParams.SpringParams -> m ()), MonadIO m, IsSpringAnimation a) => O.OverloadedMethod SpringAnimationSetSpringParamsMethodInfo a signature where
    overloadedMethod = springAnimationSetSpringParams

instance O.OverloadedMethodInfo SpringAnimationSetSpringParamsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.SpringAnimation.springAnimationSetSpringParams",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-SpringAnimation.html#v:springAnimationSetSpringParams"
        })


#endif

-- method SpringAnimation::set_value_from
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "SpringAnimation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a spring animation" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value to animate from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "adw_spring_animation_set_value_from" adw_spring_animation_set_value_from :: 
    Ptr SpringAnimation ->                  -- self : TInterface (Name {namespace = "Adw", name = "SpringAnimation"})
    CDouble ->                              -- value : TBasicType TDouble
    IO ()

-- | Sets the value /@self@/ will animate from.
-- 
-- The animation will start at this value and end at
-- [property/@springAnimation@/:value-to].
springAnimationSetValueFrom ::
    (B.CallStack.HasCallStack, MonadIO m, IsSpringAnimation a) =>
    a
    -- ^ /@self@/: a spring animation
    -> Double
    -- ^ /@value@/: the value to animate from
    -> m ()
springAnimationSetValueFrom :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSpringAnimation a) =>
a -> Double -> m ()
springAnimationSetValueFrom a
self Double
value = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr SpringAnimation
self' <- a -> IO (Ptr SpringAnimation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let value' :: CDouble
value' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
value
    Ptr SpringAnimation -> CDouble -> IO ()
adw_spring_animation_set_value_from Ptr SpringAnimation
self' CDouble
value'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SpringAnimationSetValueFromMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m, IsSpringAnimation a) => O.OverloadedMethod SpringAnimationSetValueFromMethodInfo a signature where
    overloadedMethod = springAnimationSetValueFrom

instance O.OverloadedMethodInfo SpringAnimationSetValueFromMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.SpringAnimation.springAnimationSetValueFrom",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-SpringAnimation.html#v:springAnimationSetValueFrom"
        })


#endif

-- method SpringAnimation::set_value_to
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "SpringAnimation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a spring animation" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value to animate to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "adw_spring_animation_set_value_to" adw_spring_animation_set_value_to :: 
    Ptr SpringAnimation ->                  -- self : TInterface (Name {namespace = "Adw", name = "SpringAnimation"})
    CDouble ->                              -- value : TBasicType TDouble
    IO ()

-- | Sets the value /@self@/ will animate to.
-- 
-- The animation will start at [property/@springAnimation@/:value-from] and end at
-- this value.
springAnimationSetValueTo ::
    (B.CallStack.HasCallStack, MonadIO m, IsSpringAnimation a) =>
    a
    -- ^ /@self@/: a spring animation
    -> Double
    -- ^ /@value@/: the value to animate to
    -> m ()
springAnimationSetValueTo :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSpringAnimation a) =>
a -> Double -> m ()
springAnimationSetValueTo a
self Double
value = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr SpringAnimation
self' <- a -> IO (Ptr SpringAnimation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let value' :: CDouble
value' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
value
    Ptr SpringAnimation -> CDouble -> IO ()
adw_spring_animation_set_value_to Ptr SpringAnimation
self' CDouble
value'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SpringAnimationSetValueToMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m, IsSpringAnimation a) => O.OverloadedMethod SpringAnimationSetValueToMethodInfo a signature where
    overloadedMethod = springAnimationSetValueTo

instance O.OverloadedMethodInfo SpringAnimationSetValueToMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.SpringAnimation.springAnimationSetValueTo",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-SpringAnimation.html#v:springAnimationSetValueTo"
        })


#endif