{-# 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.BehaviourDepth.BehaviourDepth' structure 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.BehaviourDepth
    ( 

-- * Exported types
    BehaviourDepth(..)                      ,
    IsBehaviourDepth                        ,
    toBehaviourDepth                        ,


 -- * 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.BehaviourDepth#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.BehaviourDepth#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)
    ResolveBehaviourDepthMethod             ,
#endif

-- ** getBounds #method:getBounds#

#if defined(ENABLE_OVERLOADING)
    BehaviourDepthGetBoundsMethodInfo       ,
#endif
    behaviourDepthGetBounds                 ,


-- ** new #method:new#

    behaviourDepthNew                       ,


-- ** setBounds #method:setBounds#

#if defined(ENABLE_OVERLOADING)
    BehaviourDepthSetBoundsMethodInfo       ,
#endif
    behaviourDepthSetBounds                 ,




 -- * Properties


-- ** depthEnd #attr:depthEnd#
-- | End depth level to apply to the actors.
-- 
-- /Since: 0.4/

#if defined(ENABLE_OVERLOADING)
    BehaviourDepthDepthEndPropertyInfo      ,
#endif
#if defined(ENABLE_OVERLOADING)
    behaviourDepthDepthEnd                  ,
#endif
    constructBehaviourDepthDepthEnd         ,
    getBehaviourDepthDepthEnd               ,
    setBehaviourDepthDepthEnd               ,


-- ** depthStart #attr:depthStart#
-- | Start depth level to apply to the actors.
-- 
-- /Since: 0.4/

#if defined(ENABLE_OVERLOADING)
    BehaviourDepthDepthStartPropertyInfo    ,
#endif
#if defined(ENABLE_OVERLOADING)
    behaviourDepthDepthStart                ,
#endif
    constructBehaviourDepthDepthStart       ,
    getBehaviourDepthDepthStart             ,
    setBehaviourDepthDepthStart             ,




    ) 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 BehaviourDepth = BehaviourDepth (SP.ManagedPtr BehaviourDepth)
    deriving (BehaviourDepth -> BehaviourDepth -> Bool
(BehaviourDepth -> BehaviourDepth -> Bool)
-> (BehaviourDepth -> BehaviourDepth -> Bool) -> Eq BehaviourDepth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BehaviourDepth -> BehaviourDepth -> Bool
== :: BehaviourDepth -> BehaviourDepth -> Bool
$c/= :: BehaviourDepth -> BehaviourDepth -> Bool
/= :: BehaviourDepth -> BehaviourDepth -> Bool
Eq)

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

foreign import ccall "clutter_behaviour_depth_get_type"
    c_clutter_behaviour_depth_get_type :: IO B.Types.GType

instance B.Types.TypedObject BehaviourDepth where
    glibType :: IO GType
glibType = IO GType
c_clutter_behaviour_depth_get_type

instance B.Types.GObject BehaviourDepth

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

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

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

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

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

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

#endif

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

#endif

-- VVV Prop "depth-end"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

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

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

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

#if defined(ENABLE_OVERLOADING)
data BehaviourDepthDepthEndPropertyInfo
instance AttrInfo BehaviourDepthDepthEndPropertyInfo where
    type AttrAllowedOps BehaviourDepthDepthEndPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint BehaviourDepthDepthEndPropertyInfo = IsBehaviourDepth
    type AttrSetTypeConstraint BehaviourDepthDepthEndPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint BehaviourDepthDepthEndPropertyInfo = (~) Int32
    type AttrTransferType BehaviourDepthDepthEndPropertyInfo = Int32
    type AttrGetType BehaviourDepthDepthEndPropertyInfo = Int32
    type AttrLabel BehaviourDepthDepthEndPropertyInfo = "depth-end"
    type AttrOrigin BehaviourDepthDepthEndPropertyInfo = BehaviourDepth
    attrGet = getBehaviourDepthDepthEnd
    attrSet = setBehaviourDepthDepthEnd
    attrTransfer _ v = do
        return v
    attrConstruct = constructBehaviourDepthDepthEnd
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.BehaviourDepth.depthEnd"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-BehaviourDepth.html#g:attr:depthEnd"
        })
#endif

-- VVV Prop "depth-start"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

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

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

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

#if defined(ENABLE_OVERLOADING)
data BehaviourDepthDepthStartPropertyInfo
instance AttrInfo BehaviourDepthDepthStartPropertyInfo where
    type AttrAllowedOps BehaviourDepthDepthStartPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint BehaviourDepthDepthStartPropertyInfo = IsBehaviourDepth
    type AttrSetTypeConstraint BehaviourDepthDepthStartPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint BehaviourDepthDepthStartPropertyInfo = (~) Int32
    type AttrTransferType BehaviourDepthDepthStartPropertyInfo = Int32
    type AttrGetType BehaviourDepthDepthStartPropertyInfo = Int32
    type AttrLabel BehaviourDepthDepthStartPropertyInfo = "depth-start"
    type AttrOrigin BehaviourDepthDepthStartPropertyInfo = BehaviourDepth
    attrGet = getBehaviourDepthDepthStart
    attrSet = setBehaviourDepthDepthStart
    attrTransfer _ v = do
        return v
    attrConstruct = constructBehaviourDepthDepthStart
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.BehaviourDepth.depthStart"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-BehaviourDepth.html#g:attr:depthStart"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList BehaviourDepth
type instance O.AttributeList BehaviourDepth = BehaviourDepthAttributeList
type BehaviourDepthAttributeList = ('[ '("alpha", Clutter.Behaviour.BehaviourAlphaPropertyInfo), '("depthEnd", BehaviourDepthDepthEndPropertyInfo), '("depthStart", BehaviourDepthDepthStartPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
behaviourDepthDepthEnd :: AttrLabelProxy "depthEnd"
behaviourDepthDepthEnd = AttrLabelProxy

behaviourDepthDepthStart :: AttrLabelProxy "depthStart"
behaviourDepthDepthStart = AttrLabelProxy

#endif

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

#endif

-- method BehaviourDepth::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 = "depth_start"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "initial value of the depth"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "depth_end"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "final value of the depth"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Clutter" , name = "BehaviourDepth" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_behaviour_depth_new" clutter_behaviour_depth_new :: 
    Ptr Clutter.Alpha.Alpha ->              -- alpha : TInterface (Name {namespace = "Clutter", name = "Alpha"})
    Int32 ->                                -- depth_start : TBasicType TInt
    Int32 ->                                -- depth_end : TBasicType TInt
    IO (Ptr BehaviourDepth)

{-# DEPRECATED behaviourDepthNew ["(Since version 1.6)"] #-}
-- | Creates a new t'GI.Clutter.Objects.BehaviourDepth.BehaviourDepth' which can be used to control
-- the ClutterActor:depth property of a set of t'GI.Clutter.Objects.Actor.Actor's.
-- 
-- 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.4/
behaviourDepthNew ::
    (B.CallStack.HasCallStack, MonadIO m, Clutter.Alpha.IsAlpha a) =>
    Maybe (a)
    -- ^ /@alpha@/: a t'GI.Clutter.Objects.Alpha.Alpha' instance, or 'P.Nothing'
    -> Int32
    -- ^ /@depthStart@/: initial value of the depth
    -> Int32
    -- ^ /@depthEnd@/: final value of the depth
    -> m BehaviourDepth
    -- ^ __Returns:__ the newly created behaviour
behaviourDepthNew :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlpha a) =>
Maybe a -> Int32 -> Int32 -> m BehaviourDepth
behaviourDepthNew Maybe a
alpha Int32
depthStart Int32
depthEnd = IO BehaviourDepth -> m BehaviourDepth
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BehaviourDepth -> m BehaviourDepth)
-> IO BehaviourDepth -> m BehaviourDepth
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'
    Ptr BehaviourDepth
result <- Ptr Alpha -> Int32 -> Int32 -> IO (Ptr BehaviourDepth)
clutter_behaviour_depth_new Ptr Alpha
maybeAlpha Int32
depthStart Int32
depthEnd
    Text -> Ptr BehaviourDepth -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"behaviourDepthNew" Ptr BehaviourDepth
result
    BehaviourDepth
result' <- ((ManagedPtr BehaviourDepth -> BehaviourDepth)
-> Ptr BehaviourDepth -> IO BehaviourDepth
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr BehaviourDepth -> BehaviourDepth
BehaviourDepth) Ptr BehaviourDepth
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
    BehaviourDepth -> IO BehaviourDepth
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BehaviourDepth
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method BehaviourDepth::get_bounds
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "behaviour"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "BehaviourDepth" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterBehaviourDepth"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "depth_start"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for the initial depth value, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "depth_end"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for the final depth value, 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_depth_get_bounds" clutter_behaviour_depth_get_bounds :: 
    Ptr BehaviourDepth ->                   -- behaviour : TInterface (Name {namespace = "Clutter", name = "BehaviourDepth"})
    Ptr Int32 ->                            -- depth_start : TBasicType TInt
    Ptr Int32 ->                            -- depth_end : TBasicType TInt
    IO ()

{-# DEPRECATED behaviourDepthGetBounds ["(Since version 1.6)"] #-}
-- | Gets the boundaries of the /@behaviour@/
-- 
-- /Since: 0.6/
behaviourDepthGetBounds ::
    (B.CallStack.HasCallStack, MonadIO m, IsBehaviourDepth a) =>
    a
    -- ^ /@behaviour@/: a t'GI.Clutter.Objects.BehaviourDepth.BehaviourDepth'
    -> m ((Int32, Int32))
behaviourDepthGetBounds :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBehaviourDepth a) =>
a -> m (Int32, Int32)
behaviourDepthGetBounds a
behaviour = IO (Int32, Int32) -> m (Int32, Int32)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, Int32) -> m (Int32, Int32))
-> IO (Int32, Int32) -> m (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr BehaviourDepth
behaviour' <- a -> IO (Ptr BehaviourDepth)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
behaviour
    Ptr Int32
depthStart <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Int32
depthEnd <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr BehaviourDepth -> Ptr Int32 -> Ptr Int32 -> IO ()
clutter_behaviour_depth_get_bounds Ptr BehaviourDepth
behaviour' Ptr Int32
depthStart Ptr Int32
depthEnd
    Int32
depthStart' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
depthStart
    Int32
depthEnd' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
depthEnd
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
behaviour
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
depthStart
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
depthEnd
    (Int32, Int32) -> IO (Int32, Int32)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
depthStart', Int32
depthEnd')

#if defined(ENABLE_OVERLOADING)
data BehaviourDepthGetBoundsMethodInfo
instance (signature ~ (m ((Int32, Int32))), MonadIO m, IsBehaviourDepth a) => O.OverloadedMethod BehaviourDepthGetBoundsMethodInfo a signature where
    overloadedMethod = behaviourDepthGetBounds

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


#endif

-- method BehaviourDepth::set_bounds
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "behaviour"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "BehaviourDepth" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterBehaviourDepth"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "depth_start"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "initial value of the depth"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "depth_end"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "final value of the depth"
--                 , 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_depth_set_bounds" clutter_behaviour_depth_set_bounds :: 
    Ptr BehaviourDepth ->                   -- behaviour : TInterface (Name {namespace = "Clutter", name = "BehaviourDepth"})
    Int32 ->                                -- depth_start : TBasicType TInt
    Int32 ->                                -- depth_end : TBasicType TInt
    IO ()

{-# DEPRECATED behaviourDepthSetBounds ["(Since version 1.6)"] #-}
-- | Sets the boundaries of the /@behaviour@/.
-- 
-- /Since: 0.6/
behaviourDepthSetBounds ::
    (B.CallStack.HasCallStack, MonadIO m, IsBehaviourDepth a) =>
    a
    -- ^ /@behaviour@/: a t'GI.Clutter.Objects.BehaviourDepth.BehaviourDepth'
    -> Int32
    -- ^ /@depthStart@/: initial value of the depth
    -> Int32
    -- ^ /@depthEnd@/: final value of the depth
    -> m ()
behaviourDepthSetBounds :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBehaviourDepth a) =>
a -> Int32 -> Int32 -> m ()
behaviourDepthSetBounds a
behaviour Int32
depthStart Int32
depthEnd = 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 BehaviourDepth
behaviour' <- a -> IO (Ptr BehaviourDepth)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
behaviour
    Ptr BehaviourDepth -> Int32 -> Int32 -> IO ()
clutter_behaviour_depth_set_bounds Ptr BehaviourDepth
behaviour' Int32
depthStart Int32
depthEnd
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
behaviour
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BehaviourDepthSetBoundsMethodInfo
instance (signature ~ (Int32 -> Int32 -> m ()), MonadIO m, IsBehaviourDepth a) => O.OverloadedMethod BehaviourDepthSetBoundsMethodInfo a signature where
    overloadedMethod = behaviourDepthSetBounds

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


#endif