{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Physical parameters of a spring for [class/@springAnimation@/].
-- 
-- Any spring can be described by three parameters: mass, stiffness and damping.
-- 
-- An undamped spring will produce an oscillatory motion which will go on
-- forever.
-- 
-- The frequency and amplitude of the oscillations will be determined by the
-- stiffness (how \"strong\" the spring is) and its mass (how much \"inertia\" it
-- has).
-- 
-- If damping is larger than 0, the amplitude of that oscillating motion will
-- exponientally decrease over time. If that damping is strong enough that the
-- spring can\'t complete a full oscillation, it\'s called an overdamped spring.
-- 
-- If we the spring can oscillate, it\'s called an underdamped spring.
-- 
-- The value between these two behaviors is called critical damping; a
-- critically damped spring will comes to rest in the minimum possible time
-- without producing oscillations.
-- 
-- The damping can be replaced by damping ratio, which produces the following
-- springs:
-- 
-- * 0: an undamped spring.
-- * Between 0 and 1: an underdamped spring.
-- * 1: a critically damped spring.
-- * Larger than 1: an overdamped spring.
-- 
-- As such

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

module GI.Adw.Structs.SpringParams
    ( 

-- * Exported types
    SpringParams(..)                        ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [ref]("GI.Adw.Structs.SpringParams#g:method:ref"), [unref]("GI.Adw.Structs.SpringParams#g:method:unref").
-- 
-- ==== Getters
-- [getDamping]("GI.Adw.Structs.SpringParams#g:method:getDamping"), [getDampingRatio]("GI.Adw.Structs.SpringParams#g:method:getDampingRatio"), [getMass]("GI.Adw.Structs.SpringParams#g:method:getMass"), [getStiffness]("GI.Adw.Structs.SpringParams#g:method:getStiffness").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveSpringParamsMethod               ,
#endif

-- ** getDamping #method:getDamping#

#if defined(ENABLE_OVERLOADING)
    SpringParamsGetDampingMethodInfo        ,
#endif
    springParamsGetDamping                  ,


-- ** getDampingRatio #method:getDampingRatio#

#if defined(ENABLE_OVERLOADING)
    SpringParamsGetDampingRatioMethodInfo   ,
#endif
    springParamsGetDampingRatio             ,


-- ** getMass #method:getMass#

#if defined(ENABLE_OVERLOADING)
    SpringParamsGetMassMethodInfo           ,
#endif
    springParamsGetMass                     ,


-- ** getStiffness #method:getStiffness#

#if defined(ENABLE_OVERLOADING)
    SpringParamsGetStiffnessMethodInfo      ,
#endif
    springParamsGetStiffness                ,


-- ** new #method:new#

    springParamsNew                         ,


-- ** newFull #method:newFull#

    springParamsNewFull                     ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    SpringParamsRefMethodInfo               ,
#endif
    springParamsRef                         ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    SpringParamsUnrefMethodInfo             ,
#endif
    springParamsUnref                       ,




    ) 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


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

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

foreign import ccall "adw_spring_params_get_type" c_adw_spring_params_get_type :: 
    IO GType

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

instance B.Types.TypedObject SpringParams where
    glibType :: IO GType
glibType = IO GType
c_adw_spring_params_get_type

instance B.Types.GBoxed SpringParams

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


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

-- method SpringParams::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "damping_ratio"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the damping ratio of the spring"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mass"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the mass of the spring"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stiffness"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the stiffness of the spring"
--                 , 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_params_new" adw_spring_params_new :: 
    CDouble ->                              -- damping_ratio : TBasicType TDouble
    CDouble ->                              -- mass : TBasicType TDouble
    CDouble ->                              -- stiffness : TBasicType TDouble
    IO (Ptr SpringParams)

-- | Creates a new @AdwSpringParams@ from /@mass@/, /@stiffness@/ and /@dampingRatio@/.
-- 
-- The damping value is calculated from /@dampingRatio@/ and the other two
-- parameters.
-- 
-- * If /@dampingRatio@/ is 0, the spring will not be damped and will oscillate
--   endlessly.
-- * If /@dampingRatio@/ is between 0 and 1, the spring is underdamped and will
--   always overshoot.
-- * If /@dampingRatio@/ is 1, the spring is critically damped and will reach its
--   resting position the quickest way possible.
-- * If /@dampingRatio@/ is larger than 1, the spring is overdamped and will reach
--   its resting position faster than it can complete an oscillation.
-- 
-- [ctor/@springParams@/.new_full] allows to pass a raw damping value instead.
springParamsNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Double
    -- ^ /@dampingRatio@/: the damping ratio of the spring
    -> Double
    -- ^ /@mass@/: the mass of the spring
    -> Double
    -- ^ /@stiffness@/: the stiffness of the spring
    -> m SpringParams
    -- ^ __Returns:__ the newly created spring parameters
springParamsNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Double -> Double -> Double -> m SpringParams
springParamsNew Double
dampingRatio Double
mass Double
stiffness = 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
    let dampingRatio' :: CDouble
dampingRatio' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
dampingRatio
    let mass' :: CDouble
mass' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
mass
    let stiffness' :: CDouble
stiffness' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
stiffness
    Ptr SpringParams
result <- CDouble -> CDouble -> CDouble -> IO (Ptr SpringParams)
adw_spring_params_new CDouble
dampingRatio' CDouble
mass' CDouble
stiffness'
    Text -> Ptr SpringParams -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"springParamsNew" Ptr SpringParams
result
    SpringParams
result' <- ((ManagedPtr SpringParams -> SpringParams)
-> Ptr SpringParams -> IO SpringParams
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr SpringParams -> SpringParams
SpringParams) Ptr SpringParams
result
    SpringParams -> IO SpringParams
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SpringParams
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method SpringParams::new_full
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "damping"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the damping of the spring"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mass"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the mass of the spring"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stiffness"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the stiffness of the spring"
--                 , 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_params_new_full" adw_spring_params_new_full :: 
    CDouble ->                              -- damping : TBasicType TDouble
    CDouble ->                              -- mass : TBasicType TDouble
    CDouble ->                              -- stiffness : TBasicType TDouble
    IO (Ptr SpringParams)

-- | Creates a new @AdwSpringParams@ from /@mass@/, /@stiffness@/ and /@damping@/.
-- 
-- See [ctor/@springParams@/.new] for a simplified constructor using damping ratio
-- instead of /@damping@/.
springParamsNewFull ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Double
    -- ^ /@damping@/: the damping of the spring
    -> Double
    -- ^ /@mass@/: the mass of the spring
    -> Double
    -- ^ /@stiffness@/: the stiffness of the spring
    -> m SpringParams
    -- ^ __Returns:__ the newly created spring parameters
springParamsNewFull :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Double -> Double -> Double -> m SpringParams
springParamsNewFull Double
damping Double
mass Double
stiffness = 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
    let damping' :: CDouble
damping' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
damping
    let mass' :: CDouble
mass' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
mass
    let stiffness' :: CDouble
stiffness' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
stiffness
    Ptr SpringParams
result <- CDouble -> CDouble -> CDouble -> IO (Ptr SpringParams)
adw_spring_params_new_full CDouble
damping' CDouble
mass' CDouble
stiffness'
    Text -> Ptr SpringParams -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"springParamsNewFull" Ptr SpringParams
result
    SpringParams
result' <- ((ManagedPtr SpringParams -> SpringParams)
-> Ptr SpringParams -> IO SpringParams
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr SpringParams -> SpringParams
SpringParams) Ptr SpringParams
result
    SpringParams -> IO SpringParams
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SpringParams
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

-- | Gets the damping of /@self@/.
springParamsGetDamping ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    SpringParams
    -- ^ /@self@/: spring params
    -> m Double
    -- ^ __Returns:__ the damping
springParamsGetDamping :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SpringParams -> m Double
springParamsGetDamping SpringParams
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 SpringParams
self' <- SpringParams -> IO (Ptr SpringParams)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SpringParams
self
    CDouble
result <- Ptr SpringParams -> IO CDouble
adw_spring_params_get_damping Ptr SpringParams
self'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    SpringParams -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr SpringParams
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 SpringParamsGetDampingMethodInfo
instance (signature ~ (m Double), MonadIO m) => O.OverloadedMethod SpringParamsGetDampingMethodInfo SpringParams signature where
    overloadedMethod = springParamsGetDamping

instance O.OverloadedMethodInfo SpringParamsGetDampingMethodInfo SpringParams where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Structs.SpringParams.springParamsGetDamping",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Structs-SpringParams.html#v:springParamsGetDamping"
        })


#endif

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

-- | Gets the damping ratio of /@self@/.
springParamsGetDampingRatio ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    SpringParams
    -- ^ /@self@/: spring params
    -> m Double
    -- ^ __Returns:__ the damping ratio
springParamsGetDampingRatio :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SpringParams -> m Double
springParamsGetDampingRatio SpringParams
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 SpringParams
self' <- SpringParams -> IO (Ptr SpringParams)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SpringParams
self
    CDouble
result <- Ptr SpringParams -> IO CDouble
adw_spring_params_get_damping_ratio Ptr SpringParams
self'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    SpringParams -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr SpringParams
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 SpringParamsGetDampingRatioMethodInfo
instance (signature ~ (m Double), MonadIO m) => O.OverloadedMethod SpringParamsGetDampingRatioMethodInfo SpringParams signature where
    overloadedMethod = springParamsGetDampingRatio

instance O.OverloadedMethodInfo SpringParamsGetDampingRatioMethodInfo SpringParams where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Structs.SpringParams.springParamsGetDampingRatio",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Structs-SpringParams.html#v:springParamsGetDampingRatio"
        })


#endif

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

-- | Gets the mass of /@self@/.
springParamsGetMass ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    SpringParams
    -- ^ /@self@/: spring params
    -> m Double
    -- ^ __Returns:__ the mass
springParamsGetMass :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SpringParams -> m Double
springParamsGetMass SpringParams
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 SpringParams
self' <- SpringParams -> IO (Ptr SpringParams)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SpringParams
self
    CDouble
result <- Ptr SpringParams -> IO CDouble
adw_spring_params_get_mass Ptr SpringParams
self'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    SpringParams -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr SpringParams
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 SpringParamsGetMassMethodInfo
instance (signature ~ (m Double), MonadIO m) => O.OverloadedMethod SpringParamsGetMassMethodInfo SpringParams signature where
    overloadedMethod = springParamsGetMass

instance O.OverloadedMethodInfo SpringParamsGetMassMethodInfo SpringParams where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Structs.SpringParams.springParamsGetMass",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Structs-SpringParams.html#v:springParamsGetMass"
        })


#endif

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

-- | Gets the stiffness of /@self@/.
springParamsGetStiffness ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    SpringParams
    -- ^ /@self@/: spring params
    -> m Double
    -- ^ __Returns:__ the stiffness
springParamsGetStiffness :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SpringParams -> m Double
springParamsGetStiffness SpringParams
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 SpringParams
self' <- SpringParams -> IO (Ptr SpringParams)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SpringParams
self
    CDouble
result <- Ptr SpringParams -> IO CDouble
adw_spring_params_get_stiffness Ptr SpringParams
self'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    SpringParams -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr SpringParams
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 SpringParamsGetStiffnessMethodInfo
instance (signature ~ (m Double), MonadIO m) => O.OverloadedMethod SpringParamsGetStiffnessMethodInfo SpringParams signature where
    overloadedMethod = springParamsGetStiffness

instance O.OverloadedMethodInfo SpringParamsGetStiffnessMethodInfo SpringParams where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Structs.SpringParams.springParamsGetStiffness",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Structs-SpringParams.html#v:springParamsGetStiffness"
        })


#endif

-- method SpringParams::ref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "SpringParams" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "spring params" , 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_params_ref" adw_spring_params_ref :: 
    Ptr SpringParams ->                     -- self : TInterface (Name {namespace = "Adw", name = "SpringParams"})
    IO (Ptr SpringParams)

-- | Increases the reference count of /@self@/.
springParamsRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    SpringParams
    -- ^ /@self@/: spring params
    -> m SpringParams
    -- ^ __Returns:__ /@self@/
springParamsRef :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SpringParams -> m SpringParams
springParamsRef SpringParams
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 SpringParams
self' <- SpringParams -> IO (Ptr SpringParams)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SpringParams
self
    Ptr SpringParams
result <- Ptr SpringParams -> IO (Ptr SpringParams)
adw_spring_params_ref Ptr SpringParams
self'
    Text -> Ptr SpringParams -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"springParamsRef" Ptr SpringParams
result
    SpringParams
result' <- ((ManagedPtr SpringParams -> SpringParams)
-> Ptr SpringParams -> IO SpringParams
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr SpringParams -> SpringParams
SpringParams) Ptr SpringParams
result
    SpringParams -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr SpringParams
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 SpringParamsRefMethodInfo
instance (signature ~ (m SpringParams), MonadIO m) => O.OverloadedMethod SpringParamsRefMethodInfo SpringParams signature where
    overloadedMethod = springParamsRef

instance O.OverloadedMethodInfo SpringParamsRefMethodInfo SpringParams where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Structs.SpringParams.springParamsRef",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Structs-SpringParams.html#v:springParamsRef"
        })


#endif

-- method SpringParams::unref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "SpringParams" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "spring params" , 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_params_unref" adw_spring_params_unref :: 
    Ptr SpringParams ->                     -- self : TInterface (Name {namespace = "Adw", name = "SpringParams"})
    IO ()

-- | Decreases the reference count of /@self@/.
-- 
-- If the last reference is dropped, the structure is freed.
springParamsUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    SpringParams
    -- ^ /@self@/: spring params
    -> m ()
springParamsUnref :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SpringParams -> m ()
springParamsUnref SpringParams
self = 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 SpringParams
self' <- SpringParams -> IO (Ptr SpringParams)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SpringParams
self
    Ptr SpringParams -> IO ()
adw_spring_params_unref Ptr SpringParams
self'
    SpringParams -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr SpringParams
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SpringParamsUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod SpringParamsUnrefMethodInfo SpringParams signature where
    overloadedMethod = springParamsUnref

instance O.OverloadedMethodInfo SpringParamsUnrefMethodInfo SpringParams where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Structs.SpringParams.springParamsUnref",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Structs-SpringParams.html#v:springParamsUnref"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveSpringParamsMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveSpringParamsMethod "ref" o = SpringParamsRefMethodInfo
    ResolveSpringParamsMethod "unref" o = SpringParamsUnrefMethodInfo
    ResolveSpringParamsMethod "getDamping" o = SpringParamsGetDampingMethodInfo
    ResolveSpringParamsMethod "getDampingRatio" o = SpringParamsGetDampingRatioMethodInfo
    ResolveSpringParamsMethod "getMass" o = SpringParamsGetMassMethodInfo
    ResolveSpringParamsMethod "getStiffness" o = SpringParamsGetStiffnessMethodInfo
    ResolveSpringParamsMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif