{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The t'GI.Clutter.Objects.BehaviourScale.BehaviourScale' struct contains only private data and
-- should be accessed using the provided API
-- 
-- /Since: 0.2/

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

module GI.Clutter.Objects.BehaviourScale
    ( 

-- * Exported types
    BehaviourScale(..)                      ,
    IsBehaviourScale                        ,
    toBehaviourScale                        ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [actorsForeach]("GI.Clutter.Objects.Behaviour#g:method:actorsForeach"), [apply]("GI.Clutter.Objects.Behaviour#g:method:apply"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isApplied]("GI.Clutter.Objects.Behaviour#g:method:isApplied"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [parseCustomNode]("GI.Clutter.Interfaces.Scriptable#g:method:parseCustomNode"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [remove]("GI.Clutter.Objects.Behaviour#g:method:remove"), [removeAll]("GI.Clutter.Objects.Behaviour#g:method:removeAll"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getActors]("GI.Clutter.Objects.Behaviour#g:method:getActors"), [getAlpha]("GI.Clutter.Objects.Behaviour#g:method:getAlpha"), [getBounds]("GI.Clutter.Objects.BehaviourScale#g:method:getBounds"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getId]("GI.Clutter.Interfaces.Scriptable#g:method:getId"), [getNActors]("GI.Clutter.Objects.Behaviour#g:method:getNActors"), [getNthActor]("GI.Clutter.Objects.Behaviour#g:method:getNthActor"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setAlpha]("GI.Clutter.Objects.Behaviour#g:method:setAlpha"), [setBounds]("GI.Clutter.Objects.BehaviourScale#g:method:setBounds"), [setCustomProperty]("GI.Clutter.Interfaces.Scriptable#g:method:setCustomProperty"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setId]("GI.Clutter.Interfaces.Scriptable#g:method:setId"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveBehaviourScaleMethod             ,
#endif

-- ** getBounds #method:getBounds#

#if defined(ENABLE_OVERLOADING)
    BehaviourScaleGetBoundsMethodInfo       ,
#endif
    behaviourScaleGetBounds                 ,


-- ** new #method:new#

    behaviourScaleNew                       ,


-- ** setBounds #method:setBounds#

#if defined(ENABLE_OVERLOADING)
    BehaviourScaleSetBoundsMethodInfo       ,
#endif
    behaviourScaleSetBounds                 ,




 -- * Properties


-- ** xScaleEnd #attr:xScaleEnd#
-- | The final scaling factor on the X axis for the actors.
-- 
-- /Since: 0.6/

#if defined(ENABLE_OVERLOADING)
    BehaviourScaleXScaleEndPropertyInfo     ,
#endif
#if defined(ENABLE_OVERLOADING)
    behaviourScaleXScaleEnd                 ,
#endif
    constructBehaviourScaleXScaleEnd        ,
    getBehaviourScaleXScaleEnd              ,
    setBehaviourScaleXScaleEnd              ,


-- ** xScaleStart #attr:xScaleStart#
-- | The initial scaling factor on the X axis for the actors.
-- 
-- /Since: 0.6/

#if defined(ENABLE_OVERLOADING)
    BehaviourScaleXScaleStartPropertyInfo   ,
#endif
#if defined(ENABLE_OVERLOADING)
    behaviourScaleXScaleStart               ,
#endif
    constructBehaviourScaleXScaleStart      ,
    getBehaviourScaleXScaleStart            ,
    setBehaviourScaleXScaleStart            ,


-- ** yScaleEnd #attr:yScaleEnd#
-- | The final scaling factor on the Y axis for the actors.
-- 
-- /Since: 0.6/

#if defined(ENABLE_OVERLOADING)
    BehaviourScaleYScaleEndPropertyInfo     ,
#endif
#if defined(ENABLE_OVERLOADING)
    behaviourScaleYScaleEnd                 ,
#endif
    constructBehaviourScaleYScaleEnd        ,
    getBehaviourScaleYScaleEnd              ,
    setBehaviourScaleYScaleEnd              ,


-- ** yScaleStart #attr:yScaleStart#
-- | The initial scaling factor on the Y axis for the actors.
-- 
-- /Since: 0.6/

#if defined(ENABLE_OVERLOADING)
    BehaviourScaleYScaleStartPropertyInfo   ,
#endif
#if defined(ENABLE_OVERLOADING)
    behaviourScaleYScaleStart               ,
#endif
    constructBehaviourScaleYScaleStart      ,
    getBehaviourScaleYScaleStart            ,
    setBehaviourScaleYScaleStart            ,




    ) where

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

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

import {-# SOURCE #-} qualified GI.Clutter.Interfaces.Scriptable as Clutter.Scriptable
import {-# SOURCE #-} qualified GI.Clutter.Objects.Alpha as Clutter.Alpha
import {-# SOURCE #-} qualified GI.Clutter.Objects.Behaviour as Clutter.Behaviour
import qualified GI.GObject.Objects.Object as GObject.Object

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

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

foreign import ccall "clutter_behaviour_scale_get_type"
    c_clutter_behaviour_scale_get_type :: IO B.Types.GType

instance B.Types.TypedObject BehaviourScale where
    glibType :: IO GType
glibType = IO GType
c_clutter_behaviour_scale_get_type

instance B.Types.GObject BehaviourScale

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveBehaviourScaleMethod (t :: Symbol) (o :: *) :: * where
    ResolveBehaviourScaleMethod "actorsForeach" o = Clutter.Behaviour.BehaviourActorsForeachMethodInfo
    ResolveBehaviourScaleMethod "apply" o = Clutter.Behaviour.BehaviourApplyMethodInfo
    ResolveBehaviourScaleMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveBehaviourScaleMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveBehaviourScaleMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveBehaviourScaleMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveBehaviourScaleMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveBehaviourScaleMethod "isApplied" o = Clutter.Behaviour.BehaviourIsAppliedMethodInfo
    ResolveBehaviourScaleMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveBehaviourScaleMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveBehaviourScaleMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveBehaviourScaleMethod "parseCustomNode" o = Clutter.Scriptable.ScriptableParseCustomNodeMethodInfo
    ResolveBehaviourScaleMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveBehaviourScaleMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveBehaviourScaleMethod "remove" o = Clutter.Behaviour.BehaviourRemoveMethodInfo
    ResolveBehaviourScaleMethod "removeAll" o = Clutter.Behaviour.BehaviourRemoveAllMethodInfo
    ResolveBehaviourScaleMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveBehaviourScaleMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveBehaviourScaleMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveBehaviourScaleMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveBehaviourScaleMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveBehaviourScaleMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveBehaviourScaleMethod "getActors" o = Clutter.Behaviour.BehaviourGetActorsMethodInfo
    ResolveBehaviourScaleMethod "getAlpha" o = Clutter.Behaviour.BehaviourGetAlphaMethodInfo
    ResolveBehaviourScaleMethod "getBounds" o = BehaviourScaleGetBoundsMethodInfo
    ResolveBehaviourScaleMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveBehaviourScaleMethod "getId" o = Clutter.Scriptable.ScriptableGetIdMethodInfo
    ResolveBehaviourScaleMethod "getNActors" o = Clutter.Behaviour.BehaviourGetNActorsMethodInfo
    ResolveBehaviourScaleMethod "getNthActor" o = Clutter.Behaviour.BehaviourGetNthActorMethodInfo
    ResolveBehaviourScaleMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveBehaviourScaleMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveBehaviourScaleMethod "setAlpha" o = Clutter.Behaviour.BehaviourSetAlphaMethodInfo
    ResolveBehaviourScaleMethod "setBounds" o = BehaviourScaleSetBoundsMethodInfo
    ResolveBehaviourScaleMethod "setCustomProperty" o = Clutter.Scriptable.ScriptableSetCustomPropertyMethodInfo
    ResolveBehaviourScaleMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveBehaviourScaleMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveBehaviourScaleMethod "setId" o = Clutter.Scriptable.ScriptableSetIdMethodInfo
    ResolveBehaviourScaleMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveBehaviourScaleMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "x-scale-end"
   -- Type: TBasicType TDouble
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

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

-- | Set the value of the “@x-scale-end@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' behaviourScale [ #xScaleEnd 'Data.GI.Base.Attributes.:=' value ]
-- @
setBehaviourScaleXScaleEnd :: (MonadIO m, IsBehaviourScale o) => o -> Double -> m ()
setBehaviourScaleXScaleEnd :: forall (m :: * -> *) o.
(MonadIO m, IsBehaviourScale o) =>
o -> Double -> m ()
setBehaviourScaleXScaleEnd 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
"x-scale-end" Double
val

-- | Construct a `GValueConstruct` with valid value for the “@x-scale-end@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructBehaviourScaleXScaleEnd :: (IsBehaviourScale o, MIO.MonadIO m) => Double -> m (GValueConstruct o)
constructBehaviourScaleXScaleEnd :: forall o (m :: * -> *).
(IsBehaviourScale o, MonadIO m) =>
Double -> m (GValueConstruct o)
constructBehaviourScaleXScaleEnd 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
"x-scale-end" Double
val

#if defined(ENABLE_OVERLOADING)
data BehaviourScaleXScaleEndPropertyInfo
instance AttrInfo BehaviourScaleXScaleEndPropertyInfo where
    type AttrAllowedOps BehaviourScaleXScaleEndPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint BehaviourScaleXScaleEndPropertyInfo = IsBehaviourScale
    type AttrSetTypeConstraint BehaviourScaleXScaleEndPropertyInfo = (~) Double
    type AttrTransferTypeConstraint BehaviourScaleXScaleEndPropertyInfo = (~) Double
    type AttrTransferType BehaviourScaleXScaleEndPropertyInfo = Double
    type AttrGetType BehaviourScaleXScaleEndPropertyInfo = Double
    type AttrLabel BehaviourScaleXScaleEndPropertyInfo = "x-scale-end"
    type AttrOrigin BehaviourScaleXScaleEndPropertyInfo = BehaviourScale
    attrGet = getBehaviourScaleXScaleEnd
    attrSet = setBehaviourScaleXScaleEnd
    attrTransfer _ v = do
        return v
    attrConstruct = constructBehaviourScaleXScaleEnd
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.BehaviourScale.xScaleEnd"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-BehaviourScale.html#g:attr:xScaleEnd"
        })
#endif

-- VVV Prop "x-scale-start"
   -- Type: TBasicType TDouble
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

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

-- | Set the value of the “@x-scale-start@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' behaviourScale [ #xScaleStart 'Data.GI.Base.Attributes.:=' value ]
-- @
setBehaviourScaleXScaleStart :: (MonadIO m, IsBehaviourScale o) => o -> Double -> m ()
setBehaviourScaleXScaleStart :: forall (m :: * -> *) o.
(MonadIO m, IsBehaviourScale o) =>
o -> Double -> m ()
setBehaviourScaleXScaleStart 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
"x-scale-start" Double
val

-- | Construct a `GValueConstruct` with valid value for the “@x-scale-start@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructBehaviourScaleXScaleStart :: (IsBehaviourScale o, MIO.MonadIO m) => Double -> m (GValueConstruct o)
constructBehaviourScaleXScaleStart :: forall o (m :: * -> *).
(IsBehaviourScale o, MonadIO m) =>
Double -> m (GValueConstruct o)
constructBehaviourScaleXScaleStart 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
"x-scale-start" Double
val

#if defined(ENABLE_OVERLOADING)
data BehaviourScaleXScaleStartPropertyInfo
instance AttrInfo BehaviourScaleXScaleStartPropertyInfo where
    type AttrAllowedOps BehaviourScaleXScaleStartPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint BehaviourScaleXScaleStartPropertyInfo = IsBehaviourScale
    type AttrSetTypeConstraint BehaviourScaleXScaleStartPropertyInfo = (~) Double
    type AttrTransferTypeConstraint BehaviourScaleXScaleStartPropertyInfo = (~) Double
    type AttrTransferType BehaviourScaleXScaleStartPropertyInfo = Double
    type AttrGetType BehaviourScaleXScaleStartPropertyInfo = Double
    type AttrLabel BehaviourScaleXScaleStartPropertyInfo = "x-scale-start"
    type AttrOrigin BehaviourScaleXScaleStartPropertyInfo = BehaviourScale
    attrGet = getBehaviourScaleXScaleStart
    attrSet = setBehaviourScaleXScaleStart
    attrTransfer _ v = do
        return v
    attrConstruct = constructBehaviourScaleXScaleStart
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.BehaviourScale.xScaleStart"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-BehaviourScale.html#g:attr:xScaleStart"
        })
#endif

-- VVV Prop "y-scale-end"
   -- Type: TBasicType TDouble
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

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

-- | Set the value of the “@y-scale-end@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' behaviourScale [ #yScaleEnd 'Data.GI.Base.Attributes.:=' value ]
-- @
setBehaviourScaleYScaleEnd :: (MonadIO m, IsBehaviourScale o) => o -> Double -> m ()
setBehaviourScaleYScaleEnd :: forall (m :: * -> *) o.
(MonadIO m, IsBehaviourScale o) =>
o -> Double -> m ()
setBehaviourScaleYScaleEnd 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
"y-scale-end" Double
val

-- | Construct a `GValueConstruct` with valid value for the “@y-scale-end@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructBehaviourScaleYScaleEnd :: (IsBehaviourScale o, MIO.MonadIO m) => Double -> m (GValueConstruct o)
constructBehaviourScaleYScaleEnd :: forall o (m :: * -> *).
(IsBehaviourScale o, MonadIO m) =>
Double -> m (GValueConstruct o)
constructBehaviourScaleYScaleEnd 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
"y-scale-end" Double
val

#if defined(ENABLE_OVERLOADING)
data BehaviourScaleYScaleEndPropertyInfo
instance AttrInfo BehaviourScaleYScaleEndPropertyInfo where
    type AttrAllowedOps BehaviourScaleYScaleEndPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint BehaviourScaleYScaleEndPropertyInfo = IsBehaviourScale
    type AttrSetTypeConstraint BehaviourScaleYScaleEndPropertyInfo = (~) Double
    type AttrTransferTypeConstraint BehaviourScaleYScaleEndPropertyInfo = (~) Double
    type AttrTransferType BehaviourScaleYScaleEndPropertyInfo = Double
    type AttrGetType BehaviourScaleYScaleEndPropertyInfo = Double
    type AttrLabel BehaviourScaleYScaleEndPropertyInfo = "y-scale-end"
    type AttrOrigin BehaviourScaleYScaleEndPropertyInfo = BehaviourScale
    attrGet = getBehaviourScaleYScaleEnd
    attrSet = setBehaviourScaleYScaleEnd
    attrTransfer _ v = do
        return v
    attrConstruct = constructBehaviourScaleYScaleEnd
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.BehaviourScale.yScaleEnd"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-BehaviourScale.html#g:attr:yScaleEnd"
        })
#endif

-- VVV Prop "y-scale-start"
   -- Type: TBasicType TDouble
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

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

-- | Set the value of the “@y-scale-start@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' behaviourScale [ #yScaleStart 'Data.GI.Base.Attributes.:=' value ]
-- @
setBehaviourScaleYScaleStart :: (MonadIO m, IsBehaviourScale o) => o -> Double -> m ()
setBehaviourScaleYScaleStart :: forall (m :: * -> *) o.
(MonadIO m, IsBehaviourScale o) =>
o -> Double -> m ()
setBehaviourScaleYScaleStart 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
"y-scale-start" Double
val

-- | Construct a `GValueConstruct` with valid value for the “@y-scale-start@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructBehaviourScaleYScaleStart :: (IsBehaviourScale o, MIO.MonadIO m) => Double -> m (GValueConstruct o)
constructBehaviourScaleYScaleStart :: forall o (m :: * -> *).
(IsBehaviourScale o, MonadIO m) =>
Double -> m (GValueConstruct o)
constructBehaviourScaleYScaleStart 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
"y-scale-start" Double
val

#if defined(ENABLE_OVERLOADING)
data BehaviourScaleYScaleStartPropertyInfo
instance AttrInfo BehaviourScaleYScaleStartPropertyInfo where
    type AttrAllowedOps BehaviourScaleYScaleStartPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint BehaviourScaleYScaleStartPropertyInfo = IsBehaviourScale
    type AttrSetTypeConstraint BehaviourScaleYScaleStartPropertyInfo = (~) Double
    type AttrTransferTypeConstraint BehaviourScaleYScaleStartPropertyInfo = (~) Double
    type AttrTransferType BehaviourScaleYScaleStartPropertyInfo = Double
    type AttrGetType BehaviourScaleYScaleStartPropertyInfo = Double
    type AttrLabel BehaviourScaleYScaleStartPropertyInfo = "y-scale-start"
    type AttrOrigin BehaviourScaleYScaleStartPropertyInfo = BehaviourScale
    attrGet = getBehaviourScaleYScaleStart
    attrSet = setBehaviourScaleYScaleStart
    attrTransfer _ v = do
        return v
    attrConstruct = constructBehaviourScaleYScaleStart
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.BehaviourScale.yScaleStart"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-BehaviourScale.html#g:attr:yScaleStart"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList BehaviourScale
type instance O.AttributeList BehaviourScale = BehaviourScaleAttributeList
type BehaviourScaleAttributeList = ('[ '("alpha", Clutter.Behaviour.BehaviourAlphaPropertyInfo), '("xScaleEnd", BehaviourScaleXScaleEndPropertyInfo), '("xScaleStart", BehaviourScaleXScaleStartPropertyInfo), '("yScaleEnd", BehaviourScaleYScaleEndPropertyInfo), '("yScaleStart", BehaviourScaleYScaleStartPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
behaviourScaleXScaleEnd :: AttrLabelProxy "xScaleEnd"
behaviourScaleXScaleEnd = AttrLabelProxy

behaviourScaleXScaleStart :: AttrLabelProxy "xScaleStart"
behaviourScaleXScaleStart = AttrLabelProxy

behaviourScaleYScaleEnd :: AttrLabelProxy "yScaleEnd"
behaviourScaleYScaleEnd = AttrLabelProxy

behaviourScaleYScaleStart :: AttrLabelProxy "yScaleStart"
behaviourScaleYScaleStart = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList BehaviourScale = BehaviourScaleSignalList
type BehaviourScaleSignalList = ('[ '("applied", Clutter.Behaviour.BehaviourAppliedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("removed", Clutter.Behaviour.BehaviourRemovedSignalInfo)] :: [(Symbol, *)])

#endif

-- method BehaviourScale::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "alpha"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Alpha" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAlpha instance, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x_scale_start"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "initial scale factor on the X axis"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y_scale_start"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "initial scale factor on the Y axis"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x_scale_end"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "final scale factor on the X axis"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y_scale_end"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "final scale factor on the Y axis"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Clutter" , name = "BehaviourScale" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_behaviour_scale_new" clutter_behaviour_scale_new :: 
    Ptr Clutter.Alpha.Alpha ->              -- alpha : TInterface (Name {namespace = "Clutter", name = "Alpha"})
    CDouble ->                              -- x_scale_start : TBasicType TDouble
    CDouble ->                              -- y_scale_start : TBasicType TDouble
    CDouble ->                              -- x_scale_end : TBasicType TDouble
    CDouble ->                              -- y_scale_end : TBasicType TDouble
    IO (Ptr BehaviourScale)

{-# DEPRECATED behaviourScaleNew ["(Since version 1.6)"] #-}
-- | Creates a new  t'GI.Clutter.Objects.BehaviourScale.BehaviourScale' instance.
-- 
-- If /@alpha@/ is not 'P.Nothing', the t'GI.Clutter.Objects.Behaviour.Behaviour' will take ownership
-- of the t'GI.Clutter.Objects.Alpha.Alpha' instance. In the case when /@alpha@/ is 'P.Nothing',
-- it can be set later with 'GI.Clutter.Objects.Behaviour.behaviourSetAlpha'.
-- 
-- /Since: 0.2/
behaviourScaleNew ::
    (B.CallStack.HasCallStack, MonadIO m, Clutter.Alpha.IsAlpha a) =>
    Maybe (a)
    -- ^ /@alpha@/: a t'GI.Clutter.Objects.Alpha.Alpha' instance, or 'P.Nothing'
    -> Double
    -- ^ /@xScaleStart@/: initial scale factor on the X axis
    -> Double
    -- ^ /@yScaleStart@/: initial scale factor on the Y axis
    -> Double
    -- ^ /@xScaleEnd@/: final scale factor on the X axis
    -> Double
    -- ^ /@yScaleEnd@/: final scale factor on the Y axis
    -> m BehaviourScale
    -- ^ __Returns:__ the newly created t'GI.Clutter.Objects.BehaviourScale.BehaviourScale'
behaviourScaleNew :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlpha a) =>
Maybe a -> Double -> Double -> Double -> Double -> m BehaviourScale
behaviourScaleNew Maybe a
alpha Double
xScaleStart Double
yScaleStart Double
xScaleEnd Double
yScaleEnd = IO BehaviourScale -> m BehaviourScale
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BehaviourScale -> m BehaviourScale)
-> IO BehaviourScale -> m BehaviourScale
forall a b. (a -> b) -> a -> b
$ do
    Ptr Alpha
maybeAlpha <- case Maybe a
alpha of
        Maybe a
Nothing -> Ptr Alpha -> IO (Ptr Alpha)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Alpha
forall a. Ptr a
nullPtr
        Just a
jAlpha -> do
            Ptr Alpha
jAlpha' <- a -> IO (Ptr Alpha)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jAlpha
            Ptr Alpha -> IO (Ptr Alpha)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Alpha
jAlpha'
    let xScaleStart' :: CDouble
xScaleStart' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
xScaleStart
    let yScaleStart' :: CDouble
yScaleStart' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
yScaleStart
    let xScaleEnd' :: CDouble
xScaleEnd' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
xScaleEnd
    let yScaleEnd' :: CDouble
yScaleEnd' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
yScaleEnd
    Ptr BehaviourScale
result <- Ptr Alpha
-> CDouble
-> CDouble
-> CDouble
-> CDouble
-> IO (Ptr BehaviourScale)
clutter_behaviour_scale_new Ptr Alpha
maybeAlpha CDouble
xScaleStart' CDouble
yScaleStart' CDouble
xScaleEnd' CDouble
yScaleEnd'
    Text -> Ptr BehaviourScale -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"behaviourScaleNew" Ptr BehaviourScale
result
    BehaviourScale
result' <- ((ManagedPtr BehaviourScale -> BehaviourScale)
-> Ptr BehaviourScale -> IO BehaviourScale
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr BehaviourScale -> BehaviourScale
BehaviourScale) Ptr BehaviourScale
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
alpha a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    BehaviourScale -> IO BehaviourScale
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BehaviourScale
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method BehaviourScale::get_bounds
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "scale"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "BehaviourScale" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterBehaviourScale"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x_scale_start"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for the initial scale factor on the X\n  axis, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "y_scale_start"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for the initial scale factor on the Y\n  axis, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "x_scale_end"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for the final scale factor on the X axis,\n  or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "y_scale_end"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for the final scale factor on the Y axis,\n  or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_behaviour_scale_get_bounds" clutter_behaviour_scale_get_bounds :: 
    Ptr BehaviourScale ->                   -- scale : TInterface (Name {namespace = "Clutter", name = "BehaviourScale"})
    Ptr CDouble ->                          -- x_scale_start : TBasicType TDouble
    Ptr CDouble ->                          -- y_scale_start : TBasicType TDouble
    Ptr CDouble ->                          -- x_scale_end : TBasicType TDouble
    Ptr CDouble ->                          -- y_scale_end : TBasicType TDouble
    IO ()

{-# DEPRECATED behaviourScaleGetBounds ["(Since version 1.6)"] #-}
-- | Retrieves the bounds used by scale behaviour.
-- 
-- /Since: 0.4/
behaviourScaleGetBounds ::
    (B.CallStack.HasCallStack, MonadIO m, IsBehaviourScale a) =>
    a
    -- ^ /@scale@/: a t'GI.Clutter.Objects.BehaviourScale.BehaviourScale'
    -> m ((Double, Double, Double, Double))
behaviourScaleGetBounds :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBehaviourScale a) =>
a -> m (Double, Double, Double, Double)
behaviourScaleGetBounds a
scale = IO (Double, Double, Double, Double)
-> m (Double, Double, Double, Double)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Double, Double, Double, Double)
 -> m (Double, Double, Double, Double))
-> IO (Double, Double, Double, Double)
-> m (Double, Double, Double, Double)
forall a b. (a -> b) -> a -> b
$ do
    Ptr BehaviourScale
scale' <- a -> IO (Ptr BehaviourScale)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
scale
    Ptr CDouble
xScaleStart <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr CDouble
yScaleStart <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr CDouble
xScaleEnd <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr CDouble
yScaleEnd <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr BehaviourScale
-> Ptr CDouble
-> Ptr CDouble
-> Ptr CDouble
-> Ptr CDouble
-> IO ()
clutter_behaviour_scale_get_bounds Ptr BehaviourScale
scale' Ptr CDouble
xScaleStart Ptr CDouble
yScaleStart Ptr CDouble
xScaleEnd Ptr CDouble
yScaleEnd
    CDouble
xScaleStart' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
xScaleStart
    let xScaleStart'' :: Double
xScaleStart'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
xScaleStart'
    CDouble
yScaleStart' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
yScaleStart
    let yScaleStart'' :: Double
yScaleStart'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
yScaleStart'
    CDouble
xScaleEnd' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
xScaleEnd
    let xScaleEnd'' :: Double
xScaleEnd'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
xScaleEnd'
    CDouble
yScaleEnd' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
yScaleEnd
    let yScaleEnd'' :: Double
yScaleEnd'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
yScaleEnd'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
scale
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
xScaleStart
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
yScaleStart
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
xScaleEnd
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
yScaleEnd
    (Double, Double, Double, Double)
-> IO (Double, Double, Double, Double)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
xScaleStart'', Double
yScaleStart'', Double
xScaleEnd'', Double
yScaleEnd'')

#if defined(ENABLE_OVERLOADING)
data BehaviourScaleGetBoundsMethodInfo
instance (signature ~ (m ((Double, Double, Double, Double))), MonadIO m, IsBehaviourScale a) => O.OverloadedMethod BehaviourScaleGetBoundsMethodInfo a signature where
    overloadedMethod = behaviourScaleGetBounds

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


#endif

-- method BehaviourScale::set_bounds
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "scale"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "BehaviourScale" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterBehaviourScale"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x_scale_start"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "initial scale factor on the X axis"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y_scale_start"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "initial scale factor on the Y axis"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x_scale_end"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "final scale factor on the X axis"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y_scale_end"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "final scale factor on the Y axis"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_behaviour_scale_set_bounds" clutter_behaviour_scale_set_bounds :: 
    Ptr BehaviourScale ->                   -- scale : TInterface (Name {namespace = "Clutter", name = "BehaviourScale"})
    CDouble ->                              -- x_scale_start : TBasicType TDouble
    CDouble ->                              -- y_scale_start : TBasicType TDouble
    CDouble ->                              -- x_scale_end : TBasicType TDouble
    CDouble ->                              -- y_scale_end : TBasicType TDouble
    IO ()

{-# DEPRECATED behaviourScaleSetBounds ["(Since version 1.6)"] #-}
-- | Sets the bounds used by scale behaviour.
-- 
-- /Since: 0.6/
behaviourScaleSetBounds ::
    (B.CallStack.HasCallStack, MonadIO m, IsBehaviourScale a) =>
    a
    -- ^ /@scale@/: a t'GI.Clutter.Objects.BehaviourScale.BehaviourScale'
    -> Double
    -- ^ /@xScaleStart@/: initial scale factor on the X axis
    -> Double
    -- ^ /@yScaleStart@/: initial scale factor on the Y axis
    -> Double
    -- ^ /@xScaleEnd@/: final scale factor on the X axis
    -> Double
    -- ^ /@yScaleEnd@/: final scale factor on the Y axis
    -> m ()
behaviourScaleSetBounds :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBehaviourScale a) =>
a -> Double -> Double -> Double -> Double -> m ()
behaviourScaleSetBounds a
scale Double
xScaleStart Double
yScaleStart Double
xScaleEnd Double
yScaleEnd = 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 BehaviourScale
scale' <- a -> IO (Ptr BehaviourScale)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
scale
    let xScaleStart' :: CDouble
xScaleStart' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
xScaleStart
    let yScaleStart' :: CDouble
yScaleStart' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
yScaleStart
    let xScaleEnd' :: CDouble
xScaleEnd' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
xScaleEnd
    let yScaleEnd' :: CDouble
yScaleEnd' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
yScaleEnd
    Ptr BehaviourScale
-> CDouble -> CDouble -> CDouble -> CDouble -> IO ()
clutter_behaviour_scale_set_bounds Ptr BehaviourScale
scale' CDouble
xScaleStart' CDouble
yScaleStart' CDouble
xScaleEnd' CDouble
yScaleEnd'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
scale
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BehaviourScaleSetBoundsMethodInfo
instance (signature ~ (Double -> Double -> Double -> Double -> m ()), MonadIO m, IsBehaviourScale a) => O.OverloadedMethod BehaviourScaleSetBoundsMethodInfo a signature where
    overloadedMethod = behaviourScaleSetBounds

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


#endif