{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Clutter.Objects.BindConstraint.BindConstraint' is an opaque structure
-- whose members cannot be directly accessed
-- 
-- /Since: 1.4/

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

module GI.Clutter.Objects.BindConstraint
    ( 

-- * Exported types
    BindConstraint(..)                      ,
    IsBindConstraint                        ,
    toBindConstraint                        ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getActor]("GI.Clutter.Objects.ActorMeta#g:method:getActor"), [getCoordinate]("GI.Clutter.Objects.BindConstraint#g:method:getCoordinate"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getEnabled]("GI.Clutter.Objects.ActorMeta#g:method:getEnabled"), [getName]("GI.Clutter.Objects.ActorMeta#g:method:getName"), [getOffset]("GI.Clutter.Objects.BindConstraint#g:method:getOffset"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getSource]("GI.Clutter.Objects.BindConstraint#g:method:getSource").
-- 
-- ==== Setters
-- [setCoordinate]("GI.Clutter.Objects.BindConstraint#g:method:setCoordinate"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setEnabled]("GI.Clutter.Objects.ActorMeta#g:method:setEnabled"), [setName]("GI.Clutter.Objects.ActorMeta#g:method:setName"), [setOffset]("GI.Clutter.Objects.BindConstraint#g:method:setOffset"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setSource]("GI.Clutter.Objects.BindConstraint#g:method:setSource").

#if defined(ENABLE_OVERLOADING)
    ResolveBindConstraintMethod             ,
#endif

-- ** getCoordinate #method:getCoordinate#

#if defined(ENABLE_OVERLOADING)
    BindConstraintGetCoordinateMethodInfo   ,
#endif
    bindConstraintGetCoordinate             ,


-- ** getOffset #method:getOffset#

#if defined(ENABLE_OVERLOADING)
    BindConstraintGetOffsetMethodInfo       ,
#endif
    bindConstraintGetOffset                 ,


-- ** getSource #method:getSource#

#if defined(ENABLE_OVERLOADING)
    BindConstraintGetSourceMethodInfo       ,
#endif
    bindConstraintGetSource                 ,


-- ** new #method:new#

    bindConstraintNew                       ,


-- ** setCoordinate #method:setCoordinate#

#if defined(ENABLE_OVERLOADING)
    BindConstraintSetCoordinateMethodInfo   ,
#endif
    bindConstraintSetCoordinate             ,


-- ** setOffset #method:setOffset#

#if defined(ENABLE_OVERLOADING)
    BindConstraintSetOffsetMethodInfo       ,
#endif
    bindConstraintSetOffset                 ,


-- ** setSource #method:setSource#

#if defined(ENABLE_OVERLOADING)
    BindConstraintSetSourceMethodInfo       ,
#endif
    bindConstraintSetSource                 ,




 -- * Properties


-- ** coordinate #attr:coordinate#
-- | The coordinate to be bound
-- 
-- /Since: 1.4/

#if defined(ENABLE_OVERLOADING)
    BindConstraintCoordinatePropertyInfo    ,
#endif
#if defined(ENABLE_OVERLOADING)
    bindConstraintCoordinate                ,
#endif
    constructBindConstraintCoordinate       ,
    getBindConstraintCoordinate             ,
    setBindConstraintCoordinate             ,


-- ** offset #attr:offset#
-- | The offset, in pixels, to be applied to the binding
-- 
-- /Since: 1.4/

#if defined(ENABLE_OVERLOADING)
    BindConstraintOffsetPropertyInfo        ,
#endif
#if defined(ENABLE_OVERLOADING)
    bindConstraintOffset                    ,
#endif
    constructBindConstraintOffset           ,
    getBindConstraintOffset                 ,
    setBindConstraintOffset                 ,


-- ** source #attr:source#
-- | The t'GI.Clutter.Objects.Actor.Actor' used as the source for the binding.
-- 
-- The t'GI.Clutter.Objects.Actor.Actor' must not be contained inside the actor associated
-- to the constraint.
-- 
-- /Since: 1.4/

#if defined(ENABLE_OVERLOADING)
    BindConstraintSourcePropertyInfo        ,
#endif
#if defined(ENABLE_OVERLOADING)
    bindConstraintSource                    ,
#endif
    clearBindConstraintSource               ,
    constructBindConstraintSource           ,
    getBindConstraintSource                 ,
    setBindConstraintSource                 ,




    ) 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.Enums as Clutter.Enums
import {-# SOURCE #-} qualified GI.Clutter.Objects.Actor as Clutter.Actor
import {-# SOURCE #-} qualified GI.Clutter.Objects.ActorMeta as Clutter.ActorMeta
import {-# SOURCE #-} qualified GI.Clutter.Objects.Constraint as Clutter.Constraint
import qualified GI.GObject.Objects.Object as GObject.Object

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

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

foreign import ccall "clutter_bind_constraint_get_type"
    c_clutter_bind_constraint_get_type :: IO B.Types.GType

instance B.Types.TypedObject BindConstraint where
    glibType :: IO GType
glibType = IO GType
c_clutter_bind_constraint_get_type

instance B.Types.GObject BindConstraint

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

instance O.HasParentTypes BindConstraint
type instance O.ParentTypes BindConstraint = '[Clutter.Constraint.Constraint, Clutter.ActorMeta.ActorMeta, GObject.Object.Object]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveBindConstraintMethod (t :: Symbol) (o :: *) :: * where
    ResolveBindConstraintMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveBindConstraintMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveBindConstraintMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveBindConstraintMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveBindConstraintMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveBindConstraintMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveBindConstraintMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveBindConstraintMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveBindConstraintMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveBindConstraintMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveBindConstraintMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveBindConstraintMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveBindConstraintMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveBindConstraintMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveBindConstraintMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveBindConstraintMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveBindConstraintMethod "getActor" o = Clutter.ActorMeta.ActorMetaGetActorMethodInfo
    ResolveBindConstraintMethod "getCoordinate" o = BindConstraintGetCoordinateMethodInfo
    ResolveBindConstraintMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveBindConstraintMethod "getEnabled" o = Clutter.ActorMeta.ActorMetaGetEnabledMethodInfo
    ResolveBindConstraintMethod "getName" o = Clutter.ActorMeta.ActorMetaGetNameMethodInfo
    ResolveBindConstraintMethod "getOffset" o = BindConstraintGetOffsetMethodInfo
    ResolveBindConstraintMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveBindConstraintMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveBindConstraintMethod "getSource" o = BindConstraintGetSourceMethodInfo
    ResolveBindConstraintMethod "setCoordinate" o = BindConstraintSetCoordinateMethodInfo
    ResolveBindConstraintMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveBindConstraintMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveBindConstraintMethod "setEnabled" o = Clutter.ActorMeta.ActorMetaSetEnabledMethodInfo
    ResolveBindConstraintMethod "setName" o = Clutter.ActorMeta.ActorMetaSetNameMethodInfo
    ResolveBindConstraintMethod "setOffset" o = BindConstraintSetOffsetMethodInfo
    ResolveBindConstraintMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveBindConstraintMethod "setSource" o = BindConstraintSetSourceMethodInfo
    ResolveBindConstraintMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

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

-- | Get the value of the “@coordinate@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' bindConstraint #coordinate
-- @
getBindConstraintCoordinate :: (MonadIO m, IsBindConstraint o) => o -> m Clutter.Enums.BindCoordinate
getBindConstraintCoordinate :: forall (m :: * -> *) o.
(MonadIO m, IsBindConstraint o) =>
o -> m BindCoordinate
getBindConstraintCoordinate o
obj = IO BindCoordinate -> m BindCoordinate
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO BindCoordinate -> m BindCoordinate)
-> IO BindCoordinate -> m BindCoordinate
forall a b. (a -> b) -> a -> b
$ o -> String -> IO BindCoordinate
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"coordinate"

-- | Set the value of the “@coordinate@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' bindConstraint [ #coordinate 'Data.GI.Base.Attributes.:=' value ]
-- @
setBindConstraintCoordinate :: (MonadIO m, IsBindConstraint o) => o -> Clutter.Enums.BindCoordinate -> m ()
setBindConstraintCoordinate :: forall (m :: * -> *) o.
(MonadIO m, IsBindConstraint o) =>
o -> BindCoordinate -> m ()
setBindConstraintCoordinate o
obj BindCoordinate
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 -> BindCoordinate -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"coordinate" BindCoordinate
val

-- | Construct a `GValueConstruct` with valid value for the “@coordinate@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructBindConstraintCoordinate :: (IsBindConstraint o, MIO.MonadIO m) => Clutter.Enums.BindCoordinate -> m (GValueConstruct o)
constructBindConstraintCoordinate :: forall o (m :: * -> *).
(IsBindConstraint o, MonadIO m) =>
BindCoordinate -> m (GValueConstruct o)
constructBindConstraintCoordinate BindCoordinate
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 -> BindCoordinate -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"coordinate" BindCoordinate
val

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

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

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

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

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

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

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

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

-- | Set the value of the “@source@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' bindConstraint [ #source 'Data.GI.Base.Attributes.:=' value ]
-- @
setBindConstraintSource :: (MonadIO m, IsBindConstraint o, Clutter.Actor.IsActor a) => o -> a -> m ()
setBindConstraintSource :: forall (m :: * -> *) o a.
(MonadIO m, IsBindConstraint o, IsActor a) =>
o -> a -> m ()
setBindConstraintSource o
obj a
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"source" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@source@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructBindConstraintSource :: (IsBindConstraint o, MIO.MonadIO m, Clutter.Actor.IsActor a) => a -> m (GValueConstruct o)
constructBindConstraintSource :: forall o (m :: * -> *) a.
(IsBindConstraint o, MonadIO m, IsActor a) =>
a -> m (GValueConstruct o)
constructBindConstraintSource a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"source" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

-- | Set the value of the “@source@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #source
-- @
clearBindConstraintSource :: (MonadIO m, IsBindConstraint o) => o -> m ()
clearBindConstraintSource :: forall (m :: * -> *) o.
(MonadIO m, IsBindConstraint o) =>
o -> m ()
clearBindConstraintSource o
obj = 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
$ o -> String -> Maybe Actor -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"source" (Maybe Actor
forall a. Maybe a
Nothing :: Maybe Clutter.Actor.Actor)

#if defined(ENABLE_OVERLOADING)
data BindConstraintSourcePropertyInfo
instance AttrInfo BindConstraintSourcePropertyInfo where
    type AttrAllowedOps BindConstraintSourcePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint BindConstraintSourcePropertyInfo = IsBindConstraint
    type AttrSetTypeConstraint BindConstraintSourcePropertyInfo = Clutter.Actor.IsActor
    type AttrTransferTypeConstraint BindConstraintSourcePropertyInfo = Clutter.Actor.IsActor
    type AttrTransferType BindConstraintSourcePropertyInfo = Clutter.Actor.Actor
    type AttrGetType BindConstraintSourcePropertyInfo = Clutter.Actor.Actor
    type AttrLabel BindConstraintSourcePropertyInfo = "source"
    type AttrOrigin BindConstraintSourcePropertyInfo = BindConstraint
    attrGet = getBindConstraintSource
    attrSet = setBindConstraintSource
    attrTransfer _ v = do
        unsafeCastTo Clutter.Actor.Actor v
    attrConstruct = constructBindConstraintSource
    attrClear = clearBindConstraintSource
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.BindConstraint.source"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-BindConstraint.html#g:attr:source"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList BindConstraint
type instance O.AttributeList BindConstraint = BindConstraintAttributeList
type BindConstraintAttributeList = ('[ '("actor", Clutter.ActorMeta.ActorMetaActorPropertyInfo), '("coordinate", BindConstraintCoordinatePropertyInfo), '("enabled", Clutter.ActorMeta.ActorMetaEnabledPropertyInfo), '("name", Clutter.ActorMeta.ActorMetaNamePropertyInfo), '("offset", BindConstraintOffsetPropertyInfo), '("source", BindConstraintSourcePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
bindConstraintCoordinate :: AttrLabelProxy "coordinate"
bindConstraintCoordinate = AttrLabelProxy

bindConstraintOffset :: AttrLabelProxy "offset"
bindConstraintOffset = AttrLabelProxy

bindConstraintSource :: AttrLabelProxy "source"
bindConstraintSource = AttrLabelProxy

#endif

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

#endif

-- method BindConstraint::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "source"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Actor" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the #ClutterActor to use as the source of\n  the binding, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "coordinate"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "BindCoordinate" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the coordinate to bind"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "offset"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the offset to apply to the binding, in pixels"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Clutter" , name = "BindConstraint" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_bind_constraint_new" clutter_bind_constraint_new :: 
    Ptr Clutter.Actor.Actor ->              -- source : TInterface (Name {namespace = "Clutter", name = "Actor"})
    CUInt ->                                -- coordinate : TInterface (Name {namespace = "Clutter", name = "BindCoordinate"})
    CFloat ->                               -- offset : TBasicType TFloat
    IO (Ptr BindConstraint)

-- | Creates a new constraint, binding a t'GI.Clutter.Objects.Actor.Actor'\'s position to
-- the given /@coordinate@/ of the position of /@source@/
-- 
-- /Since: 1.4/
bindConstraintNew ::
    (B.CallStack.HasCallStack, MonadIO m, Clutter.Actor.IsActor a) =>
    Maybe (a)
    -- ^ /@source@/: the t'GI.Clutter.Objects.Actor.Actor' to use as the source of
    --   the binding, or 'P.Nothing'
    -> Clutter.Enums.BindCoordinate
    -- ^ /@coordinate@/: the coordinate to bind
    -> Float
    -- ^ /@offset@/: the offset to apply to the binding, in pixels
    -> m BindConstraint
    -- ^ __Returns:__ the newly created t'GI.Clutter.Objects.BindConstraint.BindConstraint'
bindConstraintNew :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsActor a) =>
Maybe a -> BindCoordinate -> Float -> m BindConstraint
bindConstraintNew Maybe a
source BindCoordinate
coordinate Float
offset = IO BindConstraint -> m BindConstraint
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BindConstraint -> m BindConstraint)
-> IO BindConstraint -> m BindConstraint
forall a b. (a -> b) -> a -> b
$ do
    Ptr Actor
maybeSource <- case Maybe a
source of
        Maybe a
Nothing -> Ptr Actor -> IO (Ptr Actor)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Actor
forall a. Ptr a
nullPtr
        Just a
jSource -> do
            Ptr Actor
jSource' <- a -> IO (Ptr Actor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jSource
            Ptr Actor -> IO (Ptr Actor)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Actor
jSource'
    let coordinate' :: CUInt
coordinate' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (BindCoordinate -> Int) -> BindCoordinate -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BindCoordinate -> Int
forall a. Enum a => a -> Int
fromEnum) BindCoordinate
coordinate
    let offset' :: CFloat
offset' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
offset
    Ptr BindConstraint
result <- Ptr Actor -> CUInt -> CFloat -> IO (Ptr BindConstraint)
clutter_bind_constraint_new Ptr Actor
maybeSource CUInt
coordinate' CFloat
offset'
    Text -> Ptr BindConstraint -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"bindConstraintNew" Ptr BindConstraint
result
    BindConstraint
result' <- ((ManagedPtr BindConstraint -> BindConstraint)
-> Ptr BindConstraint -> IO BindConstraint
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr BindConstraint -> BindConstraint
BindConstraint) Ptr BindConstraint
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
source a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    BindConstraint -> IO BindConstraint
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BindConstraint
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "clutter_bind_constraint_get_coordinate" clutter_bind_constraint_get_coordinate :: 
    Ptr BindConstraint ->                   -- constraint : TInterface (Name {namespace = "Clutter", name = "BindConstraint"})
    IO CUInt

-- | Retrieves the bound coordinate of the constraint
-- 
-- /Since: 1.4/
bindConstraintGetCoordinate ::
    (B.CallStack.HasCallStack, MonadIO m, IsBindConstraint a) =>
    a
    -- ^ /@constraint@/: a t'GI.Clutter.Objects.BindConstraint.BindConstraint'
    -> m Clutter.Enums.BindCoordinate
    -- ^ __Returns:__ the bound coordinate
bindConstraintGetCoordinate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBindConstraint a) =>
a -> m BindCoordinate
bindConstraintGetCoordinate a
constraint = IO BindCoordinate -> m BindCoordinate
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BindCoordinate -> m BindCoordinate)
-> IO BindCoordinate -> m BindCoordinate
forall a b. (a -> b) -> a -> b
$ do
    Ptr BindConstraint
constraint' <- a -> IO (Ptr BindConstraint)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
constraint
    CUInt
result <- Ptr BindConstraint -> IO CUInt
clutter_bind_constraint_get_coordinate Ptr BindConstraint
constraint'
    let result' :: BindCoordinate
result' = (Int -> BindCoordinate
forall a. Enum a => Int -> a
toEnum (Int -> BindCoordinate)
-> (CUInt -> Int) -> CUInt -> BindCoordinate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
constraint
    BindCoordinate -> IO BindCoordinate
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BindCoordinate
result'

#if defined(ENABLE_OVERLOADING)
data BindConstraintGetCoordinateMethodInfo
instance (signature ~ (m Clutter.Enums.BindCoordinate), MonadIO m, IsBindConstraint a) => O.OverloadedMethod BindConstraintGetCoordinateMethodInfo a signature where
    overloadedMethod = bindConstraintGetCoordinate

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


#endif

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

foreign import ccall "clutter_bind_constraint_get_offset" clutter_bind_constraint_get_offset :: 
    Ptr BindConstraint ->                   -- constraint : TInterface (Name {namespace = "Clutter", name = "BindConstraint"})
    IO CFloat

-- | Retrieves the offset set using 'GI.Clutter.Objects.BindConstraint.bindConstraintSetOffset'
-- 
-- /Since: 1.4/
bindConstraintGetOffset ::
    (B.CallStack.HasCallStack, MonadIO m, IsBindConstraint a) =>
    a
    -- ^ /@constraint@/: a t'GI.Clutter.Objects.BindConstraint.BindConstraint'
    -> m Float
    -- ^ __Returns:__ the offset, in pixels
bindConstraintGetOffset :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBindConstraint a) =>
a -> m Float
bindConstraintGetOffset a
constraint = IO Float -> m Float
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ do
    Ptr BindConstraint
constraint' <- a -> IO (Ptr BindConstraint)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
constraint
    CFloat
result <- Ptr BindConstraint -> IO CFloat
clutter_bind_constraint_get_offset Ptr BindConstraint
constraint'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
constraint
    Float -> IO Float
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data BindConstraintGetOffsetMethodInfo
instance (signature ~ (m Float), MonadIO m, IsBindConstraint a) => O.OverloadedMethod BindConstraintGetOffsetMethodInfo a signature where
    overloadedMethod = bindConstraintGetOffset

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


#endif

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

foreign import ccall "clutter_bind_constraint_get_source" clutter_bind_constraint_get_source :: 
    Ptr BindConstraint ->                   -- constraint : TInterface (Name {namespace = "Clutter", name = "BindConstraint"})
    IO (Ptr Clutter.Actor.Actor)

-- | Retrieves the t'GI.Clutter.Objects.Actor.Actor' set using 'GI.Clutter.Objects.BindConstraint.bindConstraintSetSource'
-- 
-- /Since: 1.4/
bindConstraintGetSource ::
    (B.CallStack.HasCallStack, MonadIO m, IsBindConstraint a) =>
    a
    -- ^ /@constraint@/: a t'GI.Clutter.Objects.BindConstraint.BindConstraint'
    -> m Clutter.Actor.Actor
    -- ^ __Returns:__ a pointer to the source actor
bindConstraintGetSource :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBindConstraint a) =>
a -> m Actor
bindConstraintGetSource a
constraint = IO Actor -> m Actor
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Actor -> m Actor) -> IO Actor -> m Actor
forall a b. (a -> b) -> a -> b
$ do
    Ptr BindConstraint
constraint' <- a -> IO (Ptr BindConstraint)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
constraint
    Ptr Actor
result <- Ptr BindConstraint -> IO (Ptr Actor)
clutter_bind_constraint_get_source Ptr BindConstraint
constraint'
    Text -> Ptr Actor -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"bindConstraintGetSource" Ptr Actor
result
    Actor
result' <- ((ManagedPtr Actor -> Actor) -> Ptr Actor -> IO Actor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Actor -> Actor
Clutter.Actor.Actor) Ptr Actor
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
constraint
    Actor -> IO Actor
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Actor
result'

#if defined(ENABLE_OVERLOADING)
data BindConstraintGetSourceMethodInfo
instance (signature ~ (m Clutter.Actor.Actor), MonadIO m, IsBindConstraint a) => O.OverloadedMethod BindConstraintGetSourceMethodInfo a signature where
    overloadedMethod = bindConstraintGetSource

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


#endif

-- method BindConstraint::set_coordinate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "constraint"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "BindConstraint" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterBindConstraint"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "coordinate"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "BindCoordinate" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the coordinate to bind"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_bind_constraint_set_coordinate" clutter_bind_constraint_set_coordinate :: 
    Ptr BindConstraint ->                   -- constraint : TInterface (Name {namespace = "Clutter", name = "BindConstraint"})
    CUInt ->                                -- coordinate : TInterface (Name {namespace = "Clutter", name = "BindCoordinate"})
    IO ()

-- | Sets the coordinate to bind in the constraint
-- 
-- /Since: 1.4/
bindConstraintSetCoordinate ::
    (B.CallStack.HasCallStack, MonadIO m, IsBindConstraint a) =>
    a
    -- ^ /@constraint@/: a t'GI.Clutter.Objects.BindConstraint.BindConstraint'
    -> Clutter.Enums.BindCoordinate
    -- ^ /@coordinate@/: the coordinate to bind
    -> m ()
bindConstraintSetCoordinate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBindConstraint a) =>
a -> BindCoordinate -> m ()
bindConstraintSetCoordinate a
constraint BindCoordinate
coordinate = 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 BindConstraint
constraint' <- a -> IO (Ptr BindConstraint)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
constraint
    let coordinate' :: CUInt
coordinate' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (BindCoordinate -> Int) -> BindCoordinate -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BindCoordinate -> Int
forall a. Enum a => a -> Int
fromEnum) BindCoordinate
coordinate
    Ptr BindConstraint -> CUInt -> IO ()
clutter_bind_constraint_set_coordinate Ptr BindConstraint
constraint' CUInt
coordinate'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
constraint
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BindConstraintSetCoordinateMethodInfo
instance (signature ~ (Clutter.Enums.BindCoordinate -> m ()), MonadIO m, IsBindConstraint a) => O.OverloadedMethod BindConstraintSetCoordinateMethodInfo a signature where
    overloadedMethod = bindConstraintSetCoordinate

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


#endif

-- method BindConstraint::set_offset
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "constraint"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "BindConstraint" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterBindConstraint"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "offset"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the offset to apply, in pixels"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_bind_constraint_set_offset" clutter_bind_constraint_set_offset :: 
    Ptr BindConstraint ->                   -- constraint : TInterface (Name {namespace = "Clutter", name = "BindConstraint"})
    CFloat ->                               -- offset : TBasicType TFloat
    IO ()

-- | Sets the offset to be applied to the constraint
-- 
-- /Since: 1.4/
bindConstraintSetOffset ::
    (B.CallStack.HasCallStack, MonadIO m, IsBindConstraint a) =>
    a
    -- ^ /@constraint@/: a t'GI.Clutter.Objects.BindConstraint.BindConstraint'
    -> Float
    -- ^ /@offset@/: the offset to apply, in pixels
    -> m ()
bindConstraintSetOffset :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBindConstraint a) =>
a -> Float -> m ()
bindConstraintSetOffset a
constraint Float
offset = 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 BindConstraint
constraint' <- a -> IO (Ptr BindConstraint)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
constraint
    let offset' :: CFloat
offset' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
offset
    Ptr BindConstraint -> CFloat -> IO ()
clutter_bind_constraint_set_offset Ptr BindConstraint
constraint' CFloat
offset'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
constraint
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BindConstraintSetOffsetMethodInfo
instance (signature ~ (Float -> m ()), MonadIO m, IsBindConstraint a) => O.OverloadedMethod BindConstraintSetOffsetMethodInfo a signature where
    overloadedMethod = bindConstraintSetOffset

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


#endif

-- method BindConstraint::set_source
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "constraint"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "BindConstraint" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterBindConstraint"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "source"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Actor" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterActor, or %NULL to unset the source"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_bind_constraint_set_source" clutter_bind_constraint_set_source :: 
    Ptr BindConstraint ->                   -- constraint : TInterface (Name {namespace = "Clutter", name = "BindConstraint"})
    Ptr Clutter.Actor.Actor ->              -- source : TInterface (Name {namespace = "Clutter", name = "Actor"})
    IO ()

-- | Sets the source t'GI.Clutter.Objects.Actor.Actor' for the constraint
-- 
-- /Since: 1.4/
bindConstraintSetSource ::
    (B.CallStack.HasCallStack, MonadIO m, IsBindConstraint a, Clutter.Actor.IsActor b) =>
    a
    -- ^ /@constraint@/: a t'GI.Clutter.Objects.BindConstraint.BindConstraint'
    -> Maybe (b)
    -- ^ /@source@/: a t'GI.Clutter.Objects.Actor.Actor', or 'P.Nothing' to unset the source
    -> m ()
bindConstraintSetSource :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsBindConstraint a, IsActor b) =>
a -> Maybe b -> m ()
bindConstraintSetSource a
constraint Maybe b
source = 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 BindConstraint
constraint' <- a -> IO (Ptr BindConstraint)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
constraint
    Ptr Actor
maybeSource <- case Maybe b
source of
        Maybe b
Nothing -> Ptr Actor -> IO (Ptr Actor)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Actor
forall a. Ptr a
nullPtr
        Just b
jSource -> do
            Ptr Actor
jSource' <- b -> IO (Ptr Actor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jSource
            Ptr Actor -> IO (Ptr Actor)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Actor
jSource'
    Ptr BindConstraint -> Ptr Actor -> IO ()
clutter_bind_constraint_set_source Ptr BindConstraint
constraint' Ptr Actor
maybeSource
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
constraint
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
source b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BindConstraintSetSourceMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsBindConstraint a, Clutter.Actor.IsActor b) => O.OverloadedMethod BindConstraintSetSourceMethodInfo a signature where
    overloadedMethod = bindConstraintSetSource

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


#endif