{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The location and size of a rectangle.
-- 
-- The width and height of a t'GI.Clutter.Structs.Rect.Rect' can be negative; Clutter considers
-- a rectangle with an origin of [ 0.0, 0.0 ] and a size of [ 10.0, 10.0 ] to
-- be equivalent to a rectangle with origin of [ 10.0, 10.0 ] and size of
-- [ -10.0, -10.0 ].
-- 
-- Application code can normalize rectangles using 'GI.Clutter.Structs.Rect.rectNormalize':
-- this function will ensure that the width and height of a t'GI.Clutter.Structs.Rect.Rect' are
-- positive values. All functions taking a t'GI.Clutter.Structs.Rect.Rect' as an argument will
-- implicitly normalize it before computing eventual results. For this reason
-- it is safer to access the contents of a t'GI.Clutter.Structs.Rect.Rect' by using the provided
-- API at all times, instead of directly accessing the structure members.
-- 
-- /Since: 1.12/

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

module GI.Clutter.Structs.Rect
    ( 

-- * Exported types
    Rect(..)                                ,
    newZeroRect                             ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [clampToPixel]("GI.Clutter.Structs.Rect#g:method:clampToPixel"), [containsPoint]("GI.Clutter.Structs.Rect#g:method:containsPoint"), [containsRect]("GI.Clutter.Structs.Rect#g:method:containsRect"), [copy]("GI.Clutter.Structs.Rect#g:method:copy"), [equals]("GI.Clutter.Structs.Rect#g:method:equals"), [free]("GI.Clutter.Structs.Rect#g:method:free"), [init]("GI.Clutter.Structs.Rect#g:method:init"), [inset]("GI.Clutter.Structs.Rect#g:method:inset"), [intersection]("GI.Clutter.Structs.Rect#g:method:intersection"), [normalize]("GI.Clutter.Structs.Rect#g:method:normalize"), [offset]("GI.Clutter.Structs.Rect#g:method:offset"), [union]("GI.Clutter.Structs.Rect#g:method:union").
-- 
-- ==== Getters
-- [getCenter]("GI.Clutter.Structs.Rect#g:method:getCenter"), [getHeight]("GI.Clutter.Structs.Rect#g:method:getHeight"), [getWidth]("GI.Clutter.Structs.Rect#g:method:getWidth"), [getX]("GI.Clutter.Structs.Rect#g:method:getX"), [getY]("GI.Clutter.Structs.Rect#g:method:getY").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveRectMethod                       ,
#endif

-- ** alloc #method:alloc#

    rectAlloc                               ,


-- ** clampToPixel #method:clampToPixel#

#if defined(ENABLE_OVERLOADING)
    RectClampToPixelMethodInfo              ,
#endif
    rectClampToPixel                        ,


-- ** containsPoint #method:containsPoint#

#if defined(ENABLE_OVERLOADING)
    RectContainsPointMethodInfo             ,
#endif
    rectContainsPoint                       ,


-- ** containsRect #method:containsRect#

#if defined(ENABLE_OVERLOADING)
    RectContainsRectMethodInfo              ,
#endif
    rectContainsRect                        ,


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    RectCopyMethodInfo                      ,
#endif
    rectCopy                                ,


-- ** equals #method:equals#

#if defined(ENABLE_OVERLOADING)
    RectEqualsMethodInfo                    ,
#endif
    rectEquals                              ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    RectFreeMethodInfo                      ,
#endif
    rectFree                                ,


-- ** getCenter #method:getCenter#

#if defined(ENABLE_OVERLOADING)
    RectGetCenterMethodInfo                 ,
#endif
    rectGetCenter                           ,


-- ** getHeight #method:getHeight#

#if defined(ENABLE_OVERLOADING)
    RectGetHeightMethodInfo                 ,
#endif
    rectGetHeight                           ,


-- ** getWidth #method:getWidth#

#if defined(ENABLE_OVERLOADING)
    RectGetWidthMethodInfo                  ,
#endif
    rectGetWidth                            ,


-- ** getX #method:getX#

#if defined(ENABLE_OVERLOADING)
    RectGetXMethodInfo                      ,
#endif
    rectGetX                                ,


-- ** getY #method:getY#

#if defined(ENABLE_OVERLOADING)
    RectGetYMethodInfo                      ,
#endif
    rectGetY                                ,


-- ** init #method:init#

#if defined(ENABLE_OVERLOADING)
    RectInitMethodInfo                      ,
#endif
    rectInit                                ,


-- ** inset #method:inset#

#if defined(ENABLE_OVERLOADING)
    RectInsetMethodInfo                     ,
#endif
    rectInset                               ,


-- ** intersection #method:intersection#

#if defined(ENABLE_OVERLOADING)
    RectIntersectionMethodInfo              ,
#endif
    rectIntersection                        ,


-- ** normalize #method:normalize#

#if defined(ENABLE_OVERLOADING)
    RectNormalizeMethodInfo                 ,
#endif
    rectNormalize                           ,


-- ** offset #method:offset#

#if defined(ENABLE_OVERLOADING)
    RectOffsetMethodInfo                    ,
#endif
    rectOffset                              ,


-- ** union #method:union#

#if defined(ENABLE_OVERLOADING)
    RectUnionMethodInfo                     ,
#endif
    rectUnion                               ,


-- ** zero #method:zero#

    rectZero                                ,




 -- * Properties


-- ** origin #attr:origin#
-- | the origin of the rectangle

    getRectOrigin                           ,
#if defined(ENABLE_OVERLOADING)
    rect_origin                             ,
#endif


-- ** size #attr:size#
-- | the size of the rectangle

    getRectSize                             ,
#if defined(ENABLE_OVERLOADING)
    rect_size                               ,
#endif




    ) where

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

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

import {-# SOURCE #-} qualified GI.Clutter.Structs.Point as Clutter.Point
import {-# SOURCE #-} qualified GI.Clutter.Structs.Size as Clutter.Size

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

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

foreign import ccall "clutter_rect_get_type" c_clutter_rect_get_type :: 
    IO GType

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

instance B.Types.TypedObject Rect where
    glibType :: IO GType
glibType = IO GType
c_clutter_rect_get_type

instance B.Types.GBoxed Rect

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

-- | Construct a `Rect` struct initialized to zero.
newZeroRect :: MonadIO m => m Rect
newZeroRect :: forall (m :: * -> *). MonadIO m => m Rect
newZeroRect = IO Rect -> m Rect
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Rect -> m Rect) -> IO Rect -> m Rect
forall a b. (a -> b) -> a -> b
$ Int -> IO (Ptr Rect)
forall a. GBoxed a => Int -> IO (Ptr a)
callocBoxedBytes Int
16 IO (Ptr Rect) -> (Ptr Rect -> IO Rect) -> IO Rect
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr Rect -> Rect) -> Ptr Rect -> IO Rect
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Rect -> Rect
Rect

instance tag ~ 'AttrSet => Constructible Rect tag where
    new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr Rect -> Rect) -> [AttrOp Rect tag] -> m Rect
new ManagedPtr Rect -> Rect
_ [AttrOp Rect tag]
attrs = do
        Rect
o <- m Rect
forall (m :: * -> *). MonadIO m => m Rect
newZeroRect
        Rect -> [AttrOp Rect 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set Rect
o [AttrOp Rect tag]
[AttrOp Rect 'AttrSet]
attrs
        Rect -> m Rect
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Rect
o


-- | Get the value of the “@origin@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' rect #origin
-- @
getRectOrigin :: MonadIO m => Rect -> m Clutter.Point.Point
getRectOrigin :: forall (m :: * -> *). MonadIO m => Rect -> m Point
getRectOrigin Rect
s = IO Point -> m Point
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Point -> m Point) -> IO Point -> m Point
forall a b. (a -> b) -> a -> b
$ Rect -> (Ptr Rect -> IO Point) -> IO Point
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Rect
s ((Ptr Rect -> IO Point) -> IO Point)
-> (Ptr Rect -> IO Point) -> IO Point
forall a b. (a -> b) -> a -> b
$ \Ptr Rect
ptr -> do
    let val :: Ptr Point
val = Ptr Rect
ptr Ptr Rect -> Int -> Ptr Point
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: (Ptr Clutter.Point.Point)
    Point
val' <- ((ManagedPtr Point -> Point) -> Ptr Point -> IO Point
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Point -> Point
Clutter.Point.Point) Ptr Point
val
    Point -> IO Point
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Point
val'

#if defined(ENABLE_OVERLOADING)
data RectOriginFieldInfo
instance AttrInfo RectOriginFieldInfo where
    type AttrBaseTypeConstraint RectOriginFieldInfo = (~) Rect
    type AttrAllowedOps RectOriginFieldInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint RectOriginFieldInfo = (~) (Ptr Clutter.Point.Point)
    type AttrTransferTypeConstraint RectOriginFieldInfo = (~)(Ptr Clutter.Point.Point)
    type AttrTransferType RectOriginFieldInfo = (Ptr Clutter.Point.Point)
    type AttrGetType RectOriginFieldInfo = Clutter.Point.Point
    type AttrLabel RectOriginFieldInfo = "origin"
    type AttrOrigin RectOriginFieldInfo = Rect
    attrGet = getRectOrigin
    attrSet = undefined
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.Rect.origin"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Structs-Rect.html#g:attr:origin"
        })

rect_origin :: AttrLabelProxy "origin"
rect_origin = AttrLabelProxy

#endif


-- | Get the value of the “@size@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' rect #size
-- @
getRectSize :: MonadIO m => Rect -> m Clutter.Size.Size
getRectSize :: forall (m :: * -> *). MonadIO m => Rect -> m Size
getRectSize Rect
s = IO Size -> m Size
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Size -> m Size) -> IO Size -> m Size
forall a b. (a -> b) -> a -> b
$ Rect -> (Ptr Rect -> IO Size) -> IO Size
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Rect
s ((Ptr Rect -> IO Size) -> IO Size)
-> (Ptr Rect -> IO Size) -> IO Size
forall a b. (a -> b) -> a -> b
$ \Ptr Rect
ptr -> do
    let val :: Ptr Size
val = Ptr Rect
ptr Ptr Rect -> Int -> Ptr Size
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: (Ptr Clutter.Size.Size)
    Size
val' <- ((ManagedPtr Size -> Size) -> Ptr Size -> IO Size
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Size -> Size
Clutter.Size.Size) Ptr Size
val
    Size -> IO Size
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Size
val'

#if defined(ENABLE_OVERLOADING)
data RectSizeFieldInfo
instance AttrInfo RectSizeFieldInfo where
    type AttrBaseTypeConstraint RectSizeFieldInfo = (~) Rect
    type AttrAllowedOps RectSizeFieldInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint RectSizeFieldInfo = (~) (Ptr Clutter.Size.Size)
    type AttrTransferTypeConstraint RectSizeFieldInfo = (~)(Ptr Clutter.Size.Size)
    type AttrTransferType RectSizeFieldInfo = (Ptr Clutter.Size.Size)
    type AttrGetType RectSizeFieldInfo = Clutter.Size.Size
    type AttrLabel RectSizeFieldInfo = "size"
    type AttrOrigin RectSizeFieldInfo = Rect
    attrGet = getRectSize
    attrSet = undefined
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.Rect.size"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Structs-Rect.html#g:attr:size"
        })

rect_size :: AttrLabelProxy "size"
rect_size = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Rect
type instance O.AttributeList Rect = RectAttributeList
type RectAttributeList = ('[ '("origin", RectOriginFieldInfo), '("size", RectSizeFieldInfo)] :: [(Symbol, DK.Type)])
#endif

-- method Rect::alloc
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Clutter" , name = "Rect" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_rect_alloc" clutter_rect_alloc :: 
    IO (Ptr Rect)

-- | Creates a new, empty t'GI.Clutter.Structs.Rect.Rect'.
-- 
-- You can use 'GI.Clutter.Structs.Rect.rectInit' to initialize the returned rectangle,
-- for instance:
-- 
-- >
-- >  rect = clutter_rect_init (clutter_rect_alloc (), x, y, width, height);
-- 
-- 
-- /Since: 1.12/
rectAlloc ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Rect
    -- ^ __Returns:__ the newly allocated t'GI.Clutter.Structs.Rect.Rect'.
    --   Use 'GI.Clutter.Structs.Rect.rectFree' to free its resources
rectAlloc :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Rect
rectAlloc  = IO Rect -> m Rect
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Rect -> m Rect) -> IO Rect -> m Rect
forall a b. (a -> b) -> a -> b
$ do
    Ptr Rect
result <- IO (Ptr Rect)
clutter_rect_alloc
    Text -> Ptr Rect -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"rectAlloc" Ptr Rect
result
    Rect
result' <- ((ManagedPtr Rect -> Rect) -> Ptr Rect -> IO Rect
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Rect -> Rect
Rect) Ptr Rect
result
    Rect -> IO Rect
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Rect
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "clutter_rect_clamp_to_pixel" clutter_rect_clamp_to_pixel :: 
    Ptr Rect ->                             -- rect : TInterface (Name {namespace = "Clutter", name = "Rect"})
    IO ()

-- | Rounds the origin of /@rect@/ downwards to the nearest integer, and rounds
-- the size of /@rect@/ upwards to the nearest integer, so that /@rect@/ is
-- updated to the smallest rectangle capable of fully containing the
-- original, fractional rectangle.
-- 
-- /Since: 1.12/
rectClampToPixel ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Rect
    -- ^ /@rect@/: a t'GI.Clutter.Structs.Rect.Rect'
    -> m ()
rectClampToPixel :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Rect -> m ()
rectClampToPixel Rect
rect = 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 Rect
rect' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
rect
    Ptr Rect -> IO ()
clutter_rect_clamp_to_pixel Ptr Rect
rect'
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
rect
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RectClampToPixelMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod RectClampToPixelMethodInfo Rect signature where
    overloadedMethod = rectClampToPixel

instance O.OverloadedMethodInfo RectClampToPixelMethodInfo Rect where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.Rect.rectClampToPixel",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Structs-Rect.html#v:rectClampToPixel"
        })


#endif

-- method Rect::contains_point
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "rect"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterRect" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "point"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Point" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the point to check" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_rect_contains_point" clutter_rect_contains_point :: 
    Ptr Rect ->                             -- rect : TInterface (Name {namespace = "Clutter", name = "Rect"})
    Ptr Clutter.Point.Point ->              -- point : TInterface (Name {namespace = "Clutter", name = "Point"})
    IO CInt

-- | Checks whether /@point@/ is contained by /@rect@/, after normalizing the
-- rectangle.
-- 
-- /Since: 1.12/
rectContainsPoint ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Rect
    -- ^ /@rect@/: a t'GI.Clutter.Structs.Rect.Rect'
    -> Clutter.Point.Point
    -- ^ /@point@/: the point to check
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the /@point@/ is contained by /@rect@/.
rectContainsPoint :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Rect -> Point -> m Bool
rectContainsPoint Rect
rect Point
point = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Rect
rect' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
rect
    Ptr Point
point' <- Point -> IO (Ptr Point)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point
point
    CInt
result <- Ptr Rect -> Ptr Point -> IO CInt
clutter_rect_contains_point Ptr Rect
rect' Ptr Point
point'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
rect
    Point -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point
point
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data RectContainsPointMethodInfo
instance (signature ~ (Clutter.Point.Point -> m Bool), MonadIO m) => O.OverloadedMethod RectContainsPointMethodInfo Rect signature where
    overloadedMethod = rectContainsPoint

instance O.OverloadedMethodInfo RectContainsPointMethodInfo Rect where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.Rect.rectContainsPoint",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Structs-Rect.html#v:rectContainsPoint"
        })


#endif

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

foreign import ccall "clutter_rect_contains_rect" clutter_rect_contains_rect :: 
    Ptr Rect ->                             -- a : TInterface (Name {namespace = "Clutter", name = "Rect"})
    Ptr Rect ->                             -- b : TInterface (Name {namespace = "Clutter", name = "Rect"})
    IO CInt

-- | Checks whether /@a@/ contains /@b@/.
-- 
-- The first rectangle contains the second if the union of the
-- two t'GI.Clutter.Structs.Rect.Rect' is equal to the first rectangle.
-- 
-- /Since: 1.12/
rectContainsRect ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Rect
    -- ^ /@a@/: a t'GI.Clutter.Structs.Rect.Rect'
    -> Rect
    -- ^ /@b@/: a t'GI.Clutter.Structs.Rect.Rect'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the first rectangle contains the second.
rectContainsRect :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Rect -> Rect -> m Bool
rectContainsRect Rect
a Rect
b = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Rect
a' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
a
    Ptr Rect
b' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
b
    CInt
result <- Ptr Rect -> Ptr Rect -> IO CInt
clutter_rect_contains_rect Ptr Rect
a' Ptr Rect
b'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
a
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
b
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data RectContainsRectMethodInfo
instance (signature ~ (Rect -> m Bool), MonadIO m) => O.OverloadedMethod RectContainsRectMethodInfo Rect signature where
    overloadedMethod = rectContainsRect

instance O.OverloadedMethodInfo RectContainsRectMethodInfo Rect where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.Rect.rectContainsRect",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Structs-Rect.html#v:rectContainsRect"
        })


#endif

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

foreign import ccall "clutter_rect_copy" clutter_rect_copy :: 
    Ptr Rect ->                             -- rect : TInterface (Name {namespace = "Clutter", name = "Rect"})
    IO (Ptr Rect)

-- | Copies /@rect@/ into a new t'GI.Clutter.Structs.Rect.Rect' instance.
-- 
-- /Since: 1.12/
rectCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Rect
    -- ^ /@rect@/: a t'GI.Clutter.Structs.Rect.Rect'
    -> m Rect
    -- ^ __Returns:__ the newly allocate copy of /@rect@/.
    --   Use 'GI.Clutter.Structs.Rect.rectFree' to free the associated resources
rectCopy :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Rect -> m Rect
rectCopy Rect
rect = IO Rect -> m Rect
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Rect -> m Rect) -> IO Rect -> m Rect
forall a b. (a -> b) -> a -> b
$ do
    Ptr Rect
rect' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
rect
    Ptr Rect
result <- Ptr Rect -> IO (Ptr Rect)
clutter_rect_copy Ptr Rect
rect'
    Text -> Ptr Rect -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"rectCopy" Ptr Rect
result
    Rect
result' <- ((ManagedPtr Rect -> Rect) -> Ptr Rect -> IO Rect
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Rect -> Rect
Rect) Ptr Rect
result
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
rect
    Rect -> IO Rect
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Rect
result'

#if defined(ENABLE_OVERLOADING)
data RectCopyMethodInfo
instance (signature ~ (m Rect), MonadIO m) => O.OverloadedMethod RectCopyMethodInfo Rect signature where
    overloadedMethod = rectCopy

instance O.OverloadedMethodInfo RectCopyMethodInfo Rect where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.Rect.rectCopy",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Structs-Rect.html#v:rectCopy"
        })


#endif

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

foreign import ccall "clutter_rect_equals" clutter_rect_equals :: 
    Ptr Rect ->                             -- a : TInterface (Name {namespace = "Clutter", name = "Rect"})
    Ptr Rect ->                             -- b : TInterface (Name {namespace = "Clutter", name = "Rect"})
    IO CInt

-- | Checks whether /@a@/ and /@b@/ are equals.
-- 
-- This function will normalize both /@a@/ and /@b@/ before comparing
-- their origin and size.
-- 
-- /Since: 1.12/
rectEquals ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Rect
    -- ^ /@a@/: a t'GI.Clutter.Structs.Rect.Rect'
    -> Rect
    -- ^ /@b@/: a t'GI.Clutter.Structs.Rect.Rect'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the rectangles match in origin and size.
rectEquals :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Rect -> Rect -> m Bool
rectEquals Rect
a Rect
b = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Rect
a' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
a
    Ptr Rect
b' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
b
    CInt
result <- Ptr Rect -> Ptr Rect -> IO CInt
clutter_rect_equals Ptr Rect
a' Ptr Rect
b'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
a
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
b
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data RectEqualsMethodInfo
instance (signature ~ (Rect -> m Bool), MonadIO m) => O.OverloadedMethod RectEqualsMethodInfo Rect signature where
    overloadedMethod = rectEquals

instance O.OverloadedMethodInfo RectEqualsMethodInfo Rect where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.Rect.rectEquals",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Structs-Rect.html#v:rectEquals"
        })


#endif

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

foreign import ccall "clutter_rect_free" clutter_rect_free :: 
    Ptr Rect ->                             -- rect : TInterface (Name {namespace = "Clutter", name = "Rect"})
    IO ()

-- | Frees the resources allocated by /@rect@/.
-- 
-- /Since: 1.12/
rectFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Rect
    -- ^ /@rect@/: a t'GI.Clutter.Structs.Rect.Rect'
    -> m ()
rectFree :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Rect -> m ()
rectFree Rect
rect = 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 Rect
rect' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
rect
    Ptr Rect -> IO ()
clutter_rect_free Ptr Rect
rect'
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
rect
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RectFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod RectFreeMethodInfo Rect signature where
    overloadedMethod = rectFree

instance O.OverloadedMethodInfo RectFreeMethodInfo Rect where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.Rect.rectFree",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Structs-Rect.html#v:rectFree"
        })


#endif

-- method Rect::get_center
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "rect"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterRect" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "center"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Point" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterPoint" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_rect_get_center" clutter_rect_get_center :: 
    Ptr Rect ->                             -- rect : TInterface (Name {namespace = "Clutter", name = "Rect"})
    Ptr Clutter.Point.Point ->              -- center : TInterface (Name {namespace = "Clutter", name = "Point"})
    IO ()

-- | Retrieves the center of /@rect@/, after normalizing the rectangle,
-- and updates /@center@/ with the correct coordinates.
-- 
-- /Since: 1.12/
rectGetCenter ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Rect
    -- ^ /@rect@/: a t'GI.Clutter.Structs.Rect.Rect'
    -> m (Clutter.Point.Point)
rectGetCenter :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Rect -> m Point
rectGetCenter Rect
rect = IO Point -> m Point
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Point -> m Point) -> IO Point -> m Point
forall a b. (a -> b) -> a -> b
$ do
    Ptr Rect
rect' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
rect
    Ptr Point
center <- Int -> IO (Ptr Point)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
8 :: IO (Ptr Clutter.Point.Point)
    Ptr Rect -> Ptr Point -> IO ()
clutter_rect_get_center Ptr Rect
rect' Ptr Point
center
    Point
center' <- ((ManagedPtr Point -> Point) -> Ptr Point -> IO Point
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Point -> Point
Clutter.Point.Point) Ptr Point
center
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
rect
    Point -> IO Point
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Point
center'

#if defined(ENABLE_OVERLOADING)
data RectGetCenterMethodInfo
instance (signature ~ (m (Clutter.Point.Point)), MonadIO m) => O.OverloadedMethod RectGetCenterMethodInfo Rect signature where
    overloadedMethod = rectGetCenter

instance O.OverloadedMethodInfo RectGetCenterMethodInfo Rect where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.Rect.rectGetCenter",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Structs-Rect.html#v:rectGetCenter"
        })


#endif

-- method Rect::get_height
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "rect"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterRect" , 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_rect_get_height" clutter_rect_get_height :: 
    Ptr Rect ->                             -- rect : TInterface (Name {namespace = "Clutter", name = "Rect"})
    IO CFloat

-- | Retrieves the height of /@rect@/.
-- 
-- /Since: 1.12/
rectGetHeight ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Rect
    -- ^ /@rect@/: a t'GI.Clutter.Structs.Rect.Rect'
    -> m Float
    -- ^ __Returns:__ the height of the rectangle
rectGetHeight :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Rect -> m Float
rectGetHeight Rect
rect = 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 Rect
rect' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
rect
    CFloat
result <- Ptr Rect -> IO CFloat
clutter_rect_get_height Ptr Rect
rect'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
rect
    Float -> IO Float
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data RectGetHeightMethodInfo
instance (signature ~ (m Float), MonadIO m) => O.OverloadedMethod RectGetHeightMethodInfo Rect signature where
    overloadedMethod = rectGetHeight

instance O.OverloadedMethodInfo RectGetHeightMethodInfo Rect where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.Rect.rectGetHeight",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Structs-Rect.html#v:rectGetHeight"
        })


#endif

-- method Rect::get_width
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "rect"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterRect" , 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_rect_get_width" clutter_rect_get_width :: 
    Ptr Rect ->                             -- rect : TInterface (Name {namespace = "Clutter", name = "Rect"})
    IO CFloat

-- | Retrieves the width of /@rect@/.
-- 
-- /Since: 1.12/
rectGetWidth ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Rect
    -- ^ /@rect@/: a t'GI.Clutter.Structs.Rect.Rect'
    -> m Float
    -- ^ __Returns:__ the width of the rectangle
rectGetWidth :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Rect -> m Float
rectGetWidth Rect
rect = 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 Rect
rect' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
rect
    CFloat
result <- Ptr Rect -> IO CFloat
clutter_rect_get_width Ptr Rect
rect'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
rect
    Float -> IO Float
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data RectGetWidthMethodInfo
instance (signature ~ (m Float), MonadIO m) => O.OverloadedMethod RectGetWidthMethodInfo Rect signature where
    overloadedMethod = rectGetWidth

instance O.OverloadedMethodInfo RectGetWidthMethodInfo Rect where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.Rect.rectGetWidth",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Structs-Rect.html#v:rectGetWidth"
        })


#endif

-- method Rect::get_x
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "rect"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterRect" , 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_rect_get_x" clutter_rect_get_x :: 
    Ptr Rect ->                             -- rect : TInterface (Name {namespace = "Clutter", name = "Rect"})
    IO CFloat

-- | Retrieves the X coordinate of the origin of /@rect@/.
-- 
-- /Since: 1.12/
rectGetX ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Rect
    -- ^ /@rect@/: a t'GI.Clutter.Structs.Rect.Rect'
    -> m Float
    -- ^ __Returns:__ the X coordinate of the origin of the rectangle
rectGetX :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Rect -> m Float
rectGetX Rect
rect = 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 Rect
rect' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
rect
    CFloat
result <- Ptr Rect -> IO CFloat
clutter_rect_get_x Ptr Rect
rect'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
rect
    Float -> IO Float
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data RectGetXMethodInfo
instance (signature ~ (m Float), MonadIO m) => O.OverloadedMethod RectGetXMethodInfo Rect signature where
    overloadedMethod = rectGetX

instance O.OverloadedMethodInfo RectGetXMethodInfo Rect where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.Rect.rectGetX",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Structs-Rect.html#v:rectGetX"
        })


#endif

-- method Rect::get_y
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "rect"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterRect" , 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_rect_get_y" clutter_rect_get_y :: 
    Ptr Rect ->                             -- rect : TInterface (Name {namespace = "Clutter", name = "Rect"})
    IO CFloat

-- | Retrieves the Y coordinate of the origin of /@rect@/.
-- 
-- /Since: 1.12/
rectGetY ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Rect
    -- ^ /@rect@/: a t'GI.Clutter.Structs.Rect.Rect'
    -> m Float
    -- ^ __Returns:__ the Y coordinate of the origin of the rectangle
rectGetY :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Rect -> m Float
rectGetY Rect
rect = 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 Rect
rect' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
rect
    CFloat
result <- Ptr Rect -> IO CFloat
clutter_rect_get_y Ptr Rect
rect'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
rect
    Float -> IO Float
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data RectGetYMethodInfo
instance (signature ~ (m Float), MonadIO m) => O.OverloadedMethod RectGetYMethodInfo Rect signature where
    overloadedMethod = rectGetY

instance O.OverloadedMethodInfo RectGetYMethodInfo Rect where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.Rect.rectGetY",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Structs-Rect.html#v:rectGetY"
        })


#endif

-- method Rect::init
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "rect"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterRect" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "X coordinate of the origin"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Y coordinate of the origin"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "width"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "width of the rectangle"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "height"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "height of the rectangle"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Clutter" , name = "Rect" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_rect_init" clutter_rect_init :: 
    Ptr Rect ->                             -- rect : TInterface (Name {namespace = "Clutter", name = "Rect"})
    CFloat ->                               -- x : TBasicType TFloat
    CFloat ->                               -- y : TBasicType TFloat
    CFloat ->                               -- width : TBasicType TFloat
    CFloat ->                               -- height : TBasicType TFloat
    IO (Ptr Rect)

-- | Initializes a t'GI.Clutter.Structs.Rect.Rect' with the given origin and size.
-- 
-- /Since: 1.12/
rectInit ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Rect
    -- ^ /@rect@/: a t'GI.Clutter.Structs.Rect.Rect'
    -> Float
    -- ^ /@x@/: X coordinate of the origin
    -> Float
    -- ^ /@y@/: Y coordinate of the origin
    -> Float
    -- ^ /@width@/: width of the rectangle
    -> Float
    -- ^ /@height@/: height of the rectangle
    -> m Rect
    -- ^ __Returns:__ the updated rectangle
rectInit :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Rect -> Float -> Float -> Float -> Float -> m Rect
rectInit Rect
rect Float
x Float
y Float
width Float
height = IO Rect -> m Rect
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Rect -> m Rect) -> IO Rect -> m Rect
forall a b. (a -> b) -> a -> b
$ do
    Ptr Rect
rect' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
rect
    let x' :: CFloat
x' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x
    let y' :: CFloat
y' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
y
    let width' :: CFloat
width' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
width
    let height' :: CFloat
height' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
height
    Ptr Rect
result <- Ptr Rect -> CFloat -> CFloat -> CFloat -> CFloat -> IO (Ptr Rect)
clutter_rect_init Ptr Rect
rect' CFloat
x' CFloat
y' CFloat
width' CFloat
height'
    Text -> Ptr Rect -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"rectInit" Ptr Rect
result
    Rect
result' <- ((ManagedPtr Rect -> Rect) -> Ptr Rect -> IO Rect
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Rect -> Rect
Rect) Ptr Rect
result
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
rect
    Rect -> IO Rect
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Rect
result'

#if defined(ENABLE_OVERLOADING)
data RectInitMethodInfo
instance (signature ~ (Float -> Float -> Float -> Float -> m Rect), MonadIO m) => O.OverloadedMethod RectInitMethodInfo Rect signature where
    overloadedMethod = rectInit

instance O.OverloadedMethodInfo RectInitMethodInfo Rect where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.Rect.rectInit",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Structs-Rect.html#v:rectInit"
        })


#endif

-- method Rect::inset
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "rect"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterRect" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "d_x"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "an horizontal value; a positive @d_x will create an inset rectangle,\n  and a negative value will create a larger rectangle"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "d_y"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a vertical value; a positive @d_x will create an inset rectangle,\n  and a negative value will create a larger rectangle"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_rect_inset" clutter_rect_inset :: 
    Ptr Rect ->                             -- rect : TInterface (Name {namespace = "Clutter", name = "Rect"})
    CFloat ->                               -- d_x : TBasicType TFloat
    CFloat ->                               -- d_y : TBasicType TFloat
    IO ()

-- | Normalizes the /@rect@/ and offsets its origin by the /@dX@/ and /@dY@/ values;
-- the size is adjusted by (2 * /@dX@/, 2 * /@dY@/).
-- 
-- If /@dX@/ and /@dY@/ are positive the size of the rectangle is decreased; if
-- the values are negative, the size of the rectangle is increased.
-- 
-- If the resulting rectangle has a negative width or height, the size is
-- set to 0.
-- 
-- /Since: 1.12/
rectInset ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Rect
    -- ^ /@rect@/: a t'GI.Clutter.Structs.Rect.Rect'
    -> Float
    -- ^ /@dX@/: an horizontal value; a positive /@dX@/ will create an inset rectangle,
    --   and a negative value will create a larger rectangle
    -> Float
    -- ^ /@dY@/: a vertical value; a positive /@dX@/ will create an inset rectangle,
    --   and a negative value will create a larger rectangle
    -> m ()
rectInset :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Rect -> Float -> Float -> m ()
rectInset Rect
rect Float
dX Float
dY = 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 Rect
rect' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
rect
    let dX' :: CFloat
dX' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
dX
    let dY' :: CFloat
dY' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
dY
    Ptr Rect -> CFloat -> CFloat -> IO ()
clutter_rect_inset Ptr Rect
rect' CFloat
dX' CFloat
dY'
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
rect
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RectInsetMethodInfo
instance (signature ~ (Float -> Float -> m ()), MonadIO m) => O.OverloadedMethod RectInsetMethodInfo Rect signature where
    overloadedMethod = rectInset

instance O.OverloadedMethodInfo RectInsetMethodInfo Rect where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.Rect.rectInset",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Structs-Rect.html#v:rectInset"
        })


#endif

-- method Rect::intersection
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "a"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterRect" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "b"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterRect" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Rect" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterRect, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_rect_intersection" clutter_rect_intersection :: 
    Ptr Rect ->                             -- a : TInterface (Name {namespace = "Clutter", name = "Rect"})
    Ptr Rect ->                             -- b : TInterface (Name {namespace = "Clutter", name = "Rect"})
    Ptr Rect ->                             -- res : TInterface (Name {namespace = "Clutter", name = "Rect"})
    IO CInt

-- | Computes the intersection of /@a@/ and /@b@/, and places it in /@res@/, if /@res@/
-- is not 'P.Nothing'.
-- 
-- This function will normalize both /@a@/ and /@b@/ prior to computing their
-- intersection.
-- 
-- This function can be used to simply check if the intersection of /@a@/ and /@b@/
-- is not empty, by using 'P.Nothing' for /@res@/.
-- 
-- /Since: 1.12/
rectIntersection ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Rect
    -- ^ /@a@/: a t'GI.Clutter.Structs.Rect.Rect'
    -> Rect
    -- ^ /@b@/: a t'GI.Clutter.Structs.Rect.Rect'
    -> m ((Bool, Rect))
    -- ^ __Returns:__ 'P.True' if the intersection of /@a@/ and /@b@/ is not empty
rectIntersection :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Rect -> Rect -> m (Bool, Rect)
rectIntersection Rect
a Rect
b = IO (Bool, Rect) -> m (Bool, Rect)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Rect) -> m (Bool, Rect))
-> IO (Bool, Rect) -> m (Bool, Rect)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Rect
a' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
a
    Ptr Rect
b' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
b
    Ptr Rect
res <- Int -> IO (Ptr Rect)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
16 :: IO (Ptr Rect)
    CInt
result <- Ptr Rect -> Ptr Rect -> Ptr Rect -> IO CInt
clutter_rect_intersection Ptr Rect
a' Ptr Rect
b' Ptr Rect
res
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Rect
res' <- ((ManagedPtr Rect -> Rect) -> Ptr Rect -> IO Rect
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Rect -> Rect
Rect) Ptr Rect
res
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
a
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
b
    (Bool, Rect) -> IO (Bool, Rect)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Rect
res')

#if defined(ENABLE_OVERLOADING)
data RectIntersectionMethodInfo
instance (signature ~ (Rect -> m ((Bool, Rect))), MonadIO m) => O.OverloadedMethod RectIntersectionMethodInfo Rect signature where
    overloadedMethod = rectIntersection

instance O.OverloadedMethodInfo RectIntersectionMethodInfo Rect where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.Rect.rectIntersection",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Structs-Rect.html#v:rectIntersection"
        })


#endif

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

foreign import ccall "clutter_rect_normalize" clutter_rect_normalize :: 
    Ptr Rect ->                             -- rect : TInterface (Name {namespace = "Clutter", name = "Rect"})
    IO (Ptr Rect)

-- | Normalizes a t'GI.Clutter.Structs.Rect.Rect'.
-- 
-- A t'GI.Clutter.Structs.Rect.Rect' is defined by the area covered by its size; this means
-- that a t'GI.Clutter.Structs.Rect.Rect' with t'GI.Clutter.Structs.Rect.Rect'.@/origin/@ in [ 0, 0 ] and a
-- t'GI.Clutter.Structs.Rect.Rect'.@/size/@ of [ 10, 10 ] is equivalent to a t'GI.Clutter.Structs.Rect.Rect' with
-- t'GI.Clutter.Structs.Rect.Rect'.@/origin/@ in [ 10, 10 ] and a t'GI.Clutter.Structs.Rect.Rect'.@/size/@ of [ -10, -10 ].
-- 
-- This function is useful to ensure that a rectangle has positive width
-- and height; it will modify the passed /@rect@/ and normalize its size.
-- 
-- /Since: 1.12/
rectNormalize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Rect
    -- ^ /@rect@/: a t'GI.Clutter.Structs.Rect.Rect'
    -> m Rect
rectNormalize :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Rect -> m Rect
rectNormalize Rect
rect = IO Rect -> m Rect
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Rect -> m Rect) -> IO Rect -> m Rect
forall a b. (a -> b) -> a -> b
$ do
    Ptr Rect
rect' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
rect
    Ptr Rect
result <- Ptr Rect -> IO (Ptr Rect)
clutter_rect_normalize Ptr Rect
rect'
    Text -> Ptr Rect -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"rectNormalize" Ptr Rect
result
    Rect
result' <- ((ManagedPtr Rect -> Rect) -> Ptr Rect -> IO Rect
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Rect -> Rect
Rect) Ptr Rect
result
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
rect
    Rect -> IO Rect
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Rect
result'

#if defined(ENABLE_OVERLOADING)
data RectNormalizeMethodInfo
instance (signature ~ (m Rect), MonadIO m) => O.OverloadedMethod RectNormalizeMethodInfo Rect signature where
    overloadedMethod = rectNormalize

instance O.OverloadedMethodInfo RectNormalizeMethodInfo Rect where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.Rect.rectNormalize",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Structs-Rect.html#v:rectNormalize"
        })


#endif

-- method Rect::offset
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "rect"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterRect" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "d_x"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the horizontal offset value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "d_y"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the vertical offset value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_rect_offset" clutter_rect_offset :: 
    Ptr Rect ->                             -- rect : TInterface (Name {namespace = "Clutter", name = "Rect"})
    CFloat ->                               -- d_x : TBasicType TFloat
    CFloat ->                               -- d_y : TBasicType TFloat
    IO ()

-- | Offsets the origin of /@rect@/ by the given values, after normalizing
-- the rectangle.
-- 
-- /Since: 1.12/
rectOffset ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Rect
    -- ^ /@rect@/: a t'GI.Clutter.Structs.Rect.Rect'
    -> Float
    -- ^ /@dX@/: the horizontal offset value
    -> Float
    -- ^ /@dY@/: the vertical offset value
    -> m ()
rectOffset :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Rect -> Float -> Float -> m ()
rectOffset Rect
rect Float
dX Float
dY = 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 Rect
rect' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
rect
    let dX' :: CFloat
dX' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
dX
    let dY' :: CFloat
dY' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
dY
    Ptr Rect -> CFloat -> CFloat -> IO ()
clutter_rect_offset Ptr Rect
rect' CFloat
dX' CFloat
dY'
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
rect
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RectOffsetMethodInfo
instance (signature ~ (Float -> Float -> m ()), MonadIO m) => O.OverloadedMethod RectOffsetMethodInfo Rect signature where
    overloadedMethod = rectOffset

instance O.OverloadedMethodInfo RectOffsetMethodInfo Rect where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.Rect.rectOffset",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Structs-Rect.html#v:rectOffset"
        })


#endif

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

foreign import ccall "clutter_rect_union" clutter_rect_union :: 
    Ptr Rect ->                             -- a : TInterface (Name {namespace = "Clutter", name = "Rect"})
    Ptr Rect ->                             -- b : TInterface (Name {namespace = "Clutter", name = "Rect"})
    Ptr Rect ->                             -- res : TInterface (Name {namespace = "Clutter", name = "Rect"})
    IO ()

-- | Computes the smallest possible rectangle capable of fully containing
-- both /@a@/ and /@b@/, and places it into /@res@/.
-- 
-- This function will normalize both /@a@/ and /@b@/ prior to computing their
-- union.
-- 
-- /Since: 1.12/
rectUnion ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Rect
    -- ^ /@a@/: a t'GI.Clutter.Structs.Rect.Rect'
    -> Rect
    -- ^ /@b@/: a t'GI.Clutter.Structs.Rect.Rect'
    -> m (Rect)
rectUnion :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Rect -> Rect -> m Rect
rectUnion Rect
a Rect
b = IO Rect -> m Rect
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Rect -> m Rect) -> IO Rect -> m Rect
forall a b. (a -> b) -> a -> b
$ do
    Ptr Rect
a' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
a
    Ptr Rect
b' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
b
    Ptr Rect
res <- Int -> IO (Ptr Rect)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
16 :: IO (Ptr Rect)
    Ptr Rect -> Ptr Rect -> Ptr Rect -> IO ()
clutter_rect_union Ptr Rect
a' Ptr Rect
b' Ptr Rect
res
    Rect
res' <- ((ManagedPtr Rect -> Rect) -> Ptr Rect -> IO Rect
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Rect -> Rect
Rect) Ptr Rect
res
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
a
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
b
    Rect -> IO Rect
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Rect
res'

#if defined(ENABLE_OVERLOADING)
data RectUnionMethodInfo
instance (signature ~ (Rect -> m (Rect)), MonadIO m) => O.OverloadedMethod RectUnionMethodInfo Rect signature where
    overloadedMethod = rectUnion

instance O.OverloadedMethodInfo RectUnionMethodInfo Rect where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.Rect.rectUnion",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Structs-Rect.html#v:rectUnion"
        })


#endif

-- method Rect::zero
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Clutter" , name = "Rect" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_rect_zero" clutter_rect_zero :: 
    IO (Ptr Rect)

-- | A t'GI.Clutter.Structs.Rect.Rect' with t'GI.Clutter.Structs.Rect.Rect'.@/origin/@ set at (0, 0) and a size
-- of 0.
-- 
-- The returned value can be used as a guard.
-- 
-- /Since: 1.12/
rectZero ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Rect
    -- ^ __Returns:__ a rectangle with origin in (0, 0) and a size of 0.
    --   The returned t'GI.Clutter.Structs.Rect.Rect' is owned by Clutter and it should not
    --   be modified or freed.
rectZero :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Rect
rectZero  = IO Rect -> m Rect
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Rect -> m Rect) -> IO Rect -> m Rect
forall a b. (a -> b) -> a -> b
$ do
    Ptr Rect
result <- IO (Ptr Rect)
clutter_rect_zero
    Text -> Ptr Rect -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"rectZero" Ptr Rect
result
    Rect
result' <- ((ManagedPtr Rect -> Rect) -> Ptr Rect -> IO Rect
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Rect -> Rect
Rect) Ptr Rect
result
    Rect -> IO Rect
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Rect
result'

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveRectMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveRectMethod "clampToPixel" o = RectClampToPixelMethodInfo
    ResolveRectMethod "containsPoint" o = RectContainsPointMethodInfo
    ResolveRectMethod "containsRect" o = RectContainsRectMethodInfo
    ResolveRectMethod "copy" o = RectCopyMethodInfo
    ResolveRectMethod "equals" o = RectEqualsMethodInfo
    ResolveRectMethod "free" o = RectFreeMethodInfo
    ResolveRectMethod "init" o = RectInitMethodInfo
    ResolveRectMethod "inset" o = RectInsetMethodInfo
    ResolveRectMethod "intersection" o = RectIntersectionMethodInfo
    ResolveRectMethod "normalize" o = RectNormalizeMethodInfo
    ResolveRectMethod "offset" o = RectOffsetMethodInfo
    ResolveRectMethod "union" o = RectUnionMethodInfo
    ResolveRectMethod "getCenter" o = RectGetCenterMethodInfo
    ResolveRectMethod "getHeight" o = RectGetHeightMethodInfo
    ResolveRectMethod "getWidth" o = RectGetWidthMethodInfo
    ResolveRectMethod "getX" o = RectGetXMethodInfo
    ResolveRectMethod "getY" o = RectGetYMethodInfo
    ResolveRectMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif