{-# 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.DeformEffect.DeformEffect' structure contains
-- only private data and should be accessed using the provided API
-- 
-- /Since: 1.4/

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

module GI.Clutter.Objects.DeformEffect
    ( 

-- * Exported types
    DeformEffect(..)                        ,
    IsDeformEffect                          ,
    toDeformEffect                          ,


 -- * 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"), [createTexture]("GI.Clutter.Objects.OffscreenEffect#g:method:createTexture"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [invalidate]("GI.Clutter.Objects.DeformEffect#g:method:invalidate"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [paintTarget]("GI.Clutter.Objects.OffscreenEffect#g:method:paintTarget"), [queueRepaint]("GI.Clutter.Objects.Effect#g:method:queueRepaint"), [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"), [getBackMaterial]("GI.Clutter.Objects.DeformEffect#g:method:getBackMaterial"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getEnabled]("GI.Clutter.Objects.ActorMeta#g:method:getEnabled"), [getNTiles]("GI.Clutter.Objects.DeformEffect#g:method:getNTiles"), [getName]("GI.Clutter.Objects.ActorMeta#g:method:getName"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getTarget]("GI.Clutter.Objects.OffscreenEffect#g:method:getTarget"), [getTargetRect]("GI.Clutter.Objects.OffscreenEffect#g:method:getTargetRect"), [getTargetSize]("GI.Clutter.Objects.OffscreenEffect#g:method:getTargetSize"), [getTexture]("GI.Clutter.Objects.OffscreenEffect#g:method:getTexture").
-- 
-- ==== Setters
-- [setBackMaterial]("GI.Clutter.Objects.DeformEffect#g:method:setBackMaterial"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setEnabled]("GI.Clutter.Objects.ActorMeta#g:method:setEnabled"), [setNTiles]("GI.Clutter.Objects.DeformEffect#g:method:setNTiles"), [setName]("GI.Clutter.Objects.ActorMeta#g:method:setName"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveDeformEffectMethod               ,
#endif

-- ** getBackMaterial #method:getBackMaterial#

#if defined(ENABLE_OVERLOADING)
    DeformEffectGetBackMaterialMethodInfo   ,
#endif
    deformEffectGetBackMaterial             ,


-- ** getNTiles #method:getNTiles#

#if defined(ENABLE_OVERLOADING)
    DeformEffectGetNTilesMethodInfo         ,
#endif
    deformEffectGetNTiles                   ,


-- ** invalidate #method:invalidate#

#if defined(ENABLE_OVERLOADING)
    DeformEffectInvalidateMethodInfo        ,
#endif
    deformEffectInvalidate                  ,


-- ** setBackMaterial #method:setBackMaterial#

#if defined(ENABLE_OVERLOADING)
    DeformEffectSetBackMaterialMethodInfo   ,
#endif
    deformEffectSetBackMaterial             ,


-- ** setNTiles #method:setNTiles#

#if defined(ENABLE_OVERLOADING)
    DeformEffectSetNTilesMethodInfo         ,
#endif
    deformEffectSetNTiles                   ,




 -- * Properties


-- ** xTiles #attr:xTiles#
-- | The number of horizontal tiles. The bigger the number, the
-- smaller the tiles
-- 
-- /Since: 1.4/

#if defined(ENABLE_OVERLOADING)
    DeformEffectXTilesPropertyInfo          ,
#endif
    constructDeformEffectXTiles             ,
#if defined(ENABLE_OVERLOADING)
    deformEffectXTiles                      ,
#endif
    getDeformEffectXTiles                   ,
    setDeformEffectXTiles                   ,


-- ** yTiles #attr:yTiles#
-- | The number of vertical tiles. The bigger the number, the
-- smaller the tiles
-- 
-- /Since: 1.4/

#if defined(ENABLE_OVERLOADING)
    DeformEffectYTilesPropertyInfo          ,
#endif
    constructDeformEffectYTiles             ,
#if defined(ENABLE_OVERLOADING)
    deformEffectYTiles                      ,
#endif
    getDeformEffectYTiles                   ,
    setDeformEffectYTiles                   ,




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

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

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

foreign import ccall "clutter_deform_effect_get_type"
    c_clutter_deform_effect_get_type :: IO B.Types.GType

instance B.Types.TypedObject DeformEffect where
    glibType :: IO GType
glibType = IO GType
c_clutter_deform_effect_get_type

instance B.Types.GObject DeformEffect

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

instance O.HasParentTypes DeformEffect
type instance O.ParentTypes DeformEffect = '[Clutter.OffscreenEffect.OffscreenEffect, Clutter.Effect.Effect, Clutter.ActorMeta.ActorMeta, GObject.Object.Object]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveDeformEffectMethod (t :: Symbol) (o :: *) :: * where
    ResolveDeformEffectMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveDeformEffectMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveDeformEffectMethod "createTexture" o = Clutter.OffscreenEffect.OffscreenEffectCreateTextureMethodInfo
    ResolveDeformEffectMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveDeformEffectMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveDeformEffectMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveDeformEffectMethod "invalidate" o = DeformEffectInvalidateMethodInfo
    ResolveDeformEffectMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveDeformEffectMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveDeformEffectMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveDeformEffectMethod "paintTarget" o = Clutter.OffscreenEffect.OffscreenEffectPaintTargetMethodInfo
    ResolveDeformEffectMethod "queueRepaint" o = Clutter.Effect.EffectQueueRepaintMethodInfo
    ResolveDeformEffectMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveDeformEffectMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveDeformEffectMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveDeformEffectMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveDeformEffectMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveDeformEffectMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveDeformEffectMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveDeformEffectMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveDeformEffectMethod "getActor" o = Clutter.ActorMeta.ActorMetaGetActorMethodInfo
    ResolveDeformEffectMethod "getBackMaterial" o = DeformEffectGetBackMaterialMethodInfo
    ResolveDeformEffectMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveDeformEffectMethod "getEnabled" o = Clutter.ActorMeta.ActorMetaGetEnabledMethodInfo
    ResolveDeformEffectMethod "getNTiles" o = DeformEffectGetNTilesMethodInfo
    ResolveDeformEffectMethod "getName" o = Clutter.ActorMeta.ActorMetaGetNameMethodInfo
    ResolveDeformEffectMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveDeformEffectMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveDeformEffectMethod "getTarget" o = Clutter.OffscreenEffect.OffscreenEffectGetTargetMethodInfo
    ResolveDeformEffectMethod "getTargetRect" o = Clutter.OffscreenEffect.OffscreenEffectGetTargetRectMethodInfo
    ResolveDeformEffectMethod "getTargetSize" o = Clutter.OffscreenEffect.OffscreenEffectGetTargetSizeMethodInfo
    ResolveDeformEffectMethod "getTexture" o = Clutter.OffscreenEffect.OffscreenEffectGetTextureMethodInfo
    ResolveDeformEffectMethod "setBackMaterial" o = DeformEffectSetBackMaterialMethodInfo
    ResolveDeformEffectMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveDeformEffectMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveDeformEffectMethod "setEnabled" o = Clutter.ActorMeta.ActorMetaSetEnabledMethodInfo
    ResolveDeformEffectMethod "setNTiles" o = DeformEffectSetNTilesMethodInfo
    ResolveDeformEffectMethod "setName" o = Clutter.ActorMeta.ActorMetaSetNameMethodInfo
    ResolveDeformEffectMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveDeformEffectMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "x-tiles"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

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

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

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

#if defined(ENABLE_OVERLOADING)
data DeformEffectXTilesPropertyInfo
instance AttrInfo DeformEffectXTilesPropertyInfo where
    type AttrAllowedOps DeformEffectXTilesPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DeformEffectXTilesPropertyInfo = IsDeformEffect
    type AttrSetTypeConstraint DeformEffectXTilesPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint DeformEffectXTilesPropertyInfo = (~) Word32
    type AttrTransferType DeformEffectXTilesPropertyInfo = Word32
    type AttrGetType DeformEffectXTilesPropertyInfo = Word32
    type AttrLabel DeformEffectXTilesPropertyInfo = "x-tiles"
    type AttrOrigin DeformEffectXTilesPropertyInfo = DeformEffect
    attrGet = getDeformEffectXTiles
    attrSet = setDeformEffectXTiles
    attrTransfer _ v = do
        return v
    attrConstruct = constructDeformEffectXTiles
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.DeformEffect.xTiles"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-DeformEffect.html#g:attr:xTiles"
        })
#endif

-- VVV Prop "y-tiles"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

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

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

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

#if defined(ENABLE_OVERLOADING)
data DeformEffectYTilesPropertyInfo
instance AttrInfo DeformEffectYTilesPropertyInfo where
    type AttrAllowedOps DeformEffectYTilesPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DeformEffectYTilesPropertyInfo = IsDeformEffect
    type AttrSetTypeConstraint DeformEffectYTilesPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint DeformEffectYTilesPropertyInfo = (~) Word32
    type AttrTransferType DeformEffectYTilesPropertyInfo = Word32
    type AttrGetType DeformEffectYTilesPropertyInfo = Word32
    type AttrLabel DeformEffectYTilesPropertyInfo = "y-tiles"
    type AttrOrigin DeformEffectYTilesPropertyInfo = DeformEffect
    attrGet = getDeformEffectYTiles
    attrSet = setDeformEffectYTiles
    attrTransfer _ v = do
        return v
    attrConstruct = constructDeformEffectYTiles
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.DeformEffect.yTiles"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-DeformEffect.html#g:attr:yTiles"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList DeformEffect
type instance O.AttributeList DeformEffect = DeformEffectAttributeList
type DeformEffectAttributeList = ('[ '("actor", Clutter.ActorMeta.ActorMetaActorPropertyInfo), '("enabled", Clutter.ActorMeta.ActorMetaEnabledPropertyInfo), '("name", Clutter.ActorMeta.ActorMetaNamePropertyInfo), '("xTiles", DeformEffectXTilesPropertyInfo), '("yTiles", DeformEffectYTilesPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
deformEffectXTiles :: AttrLabelProxy "xTiles"
deformEffectXTiles = AttrLabelProxy

deformEffectYTiles :: AttrLabelProxy "yTiles"
deformEffectYTiles = AttrLabelProxy

#endif

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

#endif

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

foreign import ccall "clutter_deform_effect_get_back_material" clutter_deform_effect_get_back_material :: 
    Ptr DeformEffect ->                     -- effect : TInterface (Name {namespace = "Clutter", name = "DeformEffect"})
    IO (Ptr ())

-- | Retrieves the handle to the back face material used by /@effect@/
-- 
-- /Since: 1.4/
deformEffectGetBackMaterial ::
    (B.CallStack.HasCallStack, MonadIO m, IsDeformEffect a) =>
    a
    -- ^ /@effect@/: a t'GI.Clutter.Objects.DeformEffect.DeformEffect'
    -> m (Ptr ())
    -- ^ __Returns:__ a handle for the material, or 'P.Nothing'.
    --   The returned material is owned by the t'GI.Clutter.Objects.DeformEffect.DeformEffect' and it
    --   should not be freed directly
deformEffectGetBackMaterial :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeformEffect a) =>
a -> m (Ptr ())
deformEffectGetBackMaterial a
effect = IO (Ptr ()) -> m (Ptr ())
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr ()) -> m (Ptr ())) -> IO (Ptr ()) -> m (Ptr ())
forall a b. (a -> b) -> a -> b
$ do
    Ptr DeformEffect
effect' <- a -> IO (Ptr DeformEffect)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
effect
    Ptr ()
result <- Ptr DeformEffect -> IO (Ptr ())
clutter_deform_effect_get_back_material Ptr DeformEffect
effect'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
effect
    Ptr () -> IO (Ptr ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
result

#if defined(ENABLE_OVERLOADING)
data DeformEffectGetBackMaterialMethodInfo
instance (signature ~ (m (Ptr ())), MonadIO m, IsDeformEffect a) => O.OverloadedMethod DeformEffectGetBackMaterialMethodInfo a signature where
    overloadedMethod = deformEffectGetBackMaterial

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


#endif

-- method DeformEffect::get_n_tiles
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "effect"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "DeformEffect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterDeformEffect"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x_tiles"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for the number of horizontal tiles,\n  or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "y_tiles"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for the number of vertical tiles,\n  or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_deform_effect_get_n_tiles" clutter_deform_effect_get_n_tiles :: 
    Ptr DeformEffect ->                     -- effect : TInterface (Name {namespace = "Clutter", name = "DeformEffect"})
    Ptr Word32 ->                           -- x_tiles : TBasicType TUInt
    Ptr Word32 ->                           -- y_tiles : TBasicType TUInt
    IO ()

-- | Retrieves the number of horizontal and vertical tiles used to sub-divide
-- the actor\'s geometry during the effect
-- 
-- /Since: 1.4/
deformEffectGetNTiles ::
    (B.CallStack.HasCallStack, MonadIO m, IsDeformEffect a) =>
    a
    -- ^ /@effect@/: a t'GI.Clutter.Objects.DeformEffect.DeformEffect'
    -> m ((Word32, Word32))
deformEffectGetNTiles :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeformEffect a) =>
a -> m (Word32, Word32)
deformEffectGetNTiles a
effect = IO (Word32, Word32) -> m (Word32, Word32)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Word32, Word32) -> m (Word32, Word32))
-> IO (Word32, Word32) -> m (Word32, Word32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DeformEffect
effect' <- a -> IO (Ptr DeformEffect)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
effect
    Ptr Word32
xTiles <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    Ptr Word32
yTiles <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    Ptr DeformEffect -> Ptr Word32 -> Ptr Word32 -> IO ()
clutter_deform_effect_get_n_tiles Ptr DeformEffect
effect' Ptr Word32
xTiles Ptr Word32
yTiles
    Word32
xTiles' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
xTiles
    Word32
yTiles' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
yTiles
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
effect
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
xTiles
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
yTiles
    (Word32, Word32) -> IO (Word32, Word32)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32
xTiles', Word32
yTiles')

#if defined(ENABLE_OVERLOADING)
data DeformEffectGetNTilesMethodInfo
instance (signature ~ (m ((Word32, Word32))), MonadIO m, IsDeformEffect a) => O.OverloadedMethod DeformEffectGetNTilesMethodInfo a signature where
    overloadedMethod = deformEffectGetNTiles

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


#endif

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

foreign import ccall "clutter_deform_effect_invalidate" clutter_deform_effect_invalidate :: 
    Ptr DeformEffect ->                     -- effect : TInterface (Name {namespace = "Clutter", name = "DeformEffect"})
    IO ()

-- | Invalidates the /@effect@/\'s vertices and, if it is associated
-- to an actor, it will queue a redraw
-- 
-- /Since: 1.4/
deformEffectInvalidate ::
    (B.CallStack.HasCallStack, MonadIO m, IsDeformEffect a) =>
    a
    -- ^ /@effect@/: a t'GI.Clutter.Objects.DeformEffect.DeformEffect'
    -> m ()
deformEffectInvalidate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeformEffect a) =>
a -> m ()
deformEffectInvalidate a
effect = 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 DeformEffect
effect' <- a -> IO (Ptr DeformEffect)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
effect
    Ptr DeformEffect -> IO ()
clutter_deform_effect_invalidate Ptr DeformEffect
effect'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
effect
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DeformEffectInvalidateMethodInfo
instance (signature ~ (m ()), MonadIO m, IsDeformEffect a) => O.OverloadedMethod DeformEffectInvalidateMethodInfo a signature where
    overloadedMethod = deformEffectInvalidate

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


#endif

-- method DeformEffect::set_back_material
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "effect"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "DeformEffect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterDeformEffect"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "material"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a handle to a Cogl material"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_deform_effect_set_back_material" clutter_deform_effect_set_back_material :: 
    Ptr DeformEffect ->                     -- effect : TInterface (Name {namespace = "Clutter", name = "DeformEffect"})
    Ptr () ->                               -- material : TBasicType TPtr
    IO ()

-- | Sets the material that should be used when drawing the back face
-- of the actor during a deformation
-- 
-- The t'GI.Clutter.Objects.DeformEffect.DeformEffect' will take a reference on the material\'s
-- handle
-- 
-- /Since: 1.4/
deformEffectSetBackMaterial ::
    (B.CallStack.HasCallStack, MonadIO m, IsDeformEffect a) =>
    a
    -- ^ /@effect@/: a t'GI.Clutter.Objects.DeformEffect.DeformEffect'
    -> Ptr ()
    -- ^ /@material@/: a handle to a Cogl material
    -> m ()
deformEffectSetBackMaterial :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeformEffect a) =>
a -> Ptr () -> m ()
deformEffectSetBackMaterial a
effect Ptr ()
material = 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 DeformEffect
effect' <- a -> IO (Ptr DeformEffect)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
effect
    Ptr DeformEffect -> Ptr () -> IO ()
clutter_deform_effect_set_back_material Ptr DeformEffect
effect' Ptr ()
material
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
effect
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DeformEffectSetBackMaterialMethodInfo
instance (signature ~ (Ptr () -> m ()), MonadIO m, IsDeformEffect a) => O.OverloadedMethod DeformEffectSetBackMaterialMethodInfo a signature where
    overloadedMethod = deformEffectSetBackMaterial

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


#endif

-- method DeformEffect::set_n_tiles
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "effect"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "DeformEffect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterDeformEffect"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x_tiles"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of horizontal tiles"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y_tiles"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of vertical tiles"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_deform_effect_set_n_tiles" clutter_deform_effect_set_n_tiles :: 
    Ptr DeformEffect ->                     -- effect : TInterface (Name {namespace = "Clutter", name = "DeformEffect"})
    Word32 ->                               -- x_tiles : TBasicType TUInt
    Word32 ->                               -- y_tiles : TBasicType TUInt
    IO ()

-- | Sets the number of horizontal and vertical tiles to be used
-- when applying the effect
-- 
-- More tiles allow a finer grained deformation at the expenses
-- of computation
-- 
-- /Since: 1.4/
deformEffectSetNTiles ::
    (B.CallStack.HasCallStack, MonadIO m, IsDeformEffect a) =>
    a
    -- ^ /@effect@/: a t'GI.Clutter.Objects.DeformEffect.DeformEffect'
    -> Word32
    -- ^ /@xTiles@/: number of horizontal tiles
    -> Word32
    -- ^ /@yTiles@/: number of vertical tiles
    -> m ()
deformEffectSetNTiles :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeformEffect a) =>
a -> Word32 -> Word32 -> m ()
deformEffectSetNTiles a
effect Word32
xTiles Word32
yTiles = 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 DeformEffect
effect' <- a -> IO (Ptr DeformEffect)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
effect
    Ptr DeformEffect -> Word32 -> Word32 -> IO ()
clutter_deform_effect_set_n_tiles Ptr DeformEffect
effect' Word32
xTiles Word32
yTiles
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
effect
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DeformEffectSetNTilesMethodInfo
instance (signature ~ (Word32 -> Word32 -> m ()), MonadIO m, IsDeformEffect a) => O.OverloadedMethod DeformEffectSetNTilesMethodInfo a signature where
    overloadedMethod = deformEffectSetNTiles

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


#endif