{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The rectangle containing an actor\'s bounding box, measured in pixels.
-- 
-- You should not use t'GI.Clutter.Structs.Geometry.Geometry', or operate on its fields
-- directly; you should use t'GI.Cairo.Structs.RectangleInt.RectangleInt' or t'GI.Clutter.Structs.Rect.Rect' if you
-- need a rectangle type, depending on the precision required.

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

module GI.Clutter.Structs.Geometry
    ( 

-- * Exported types
    Geometry(..)                            ,
    newZeroGeometry                         ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [intersects]("GI.Clutter.Structs.Geometry#g:method:intersects"), [union]("GI.Clutter.Structs.Geometry#g:method:union").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveGeometryMethod                   ,
#endif

-- ** intersects #method:intersects#

#if defined(ENABLE_OVERLOADING)
    GeometryIntersectsMethodInfo            ,
#endif
    geometryIntersects                      ,


-- ** union #method:union#

#if defined(ENABLE_OVERLOADING)
    GeometryUnionMethodInfo                 ,
#endif
    geometryUnion                           ,




 -- * Properties


-- ** height #attr:height#
-- | height of an actor

#if defined(ENABLE_OVERLOADING)
    geometry_height                         ,
#endif
    getGeometryHeight                       ,
    setGeometryHeight                       ,


-- ** width #attr:width#
-- | width of an actor

#if defined(ENABLE_OVERLOADING)
    geometry_width                          ,
#endif
    getGeometryWidth                        ,
    setGeometryWidth                        ,


-- ** x #attr:x#
-- | X coordinate of the top left corner of an actor

#if defined(ENABLE_OVERLOADING)
    geometry_x                              ,
#endif
    getGeometryX                            ,
    setGeometryX                            ,


-- ** y #attr:y#
-- | Y coordinate of the top left corner of an actor

#if defined(ENABLE_OVERLOADING)
    geometry_y                              ,
#endif
    getGeometryY                            ,
    setGeometryY                            ,




    ) 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.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


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

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

foreign import ccall "clutter_geometry_get_type" c_clutter_geometry_get_type :: 
    IO GType

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

instance B.Types.TypedObject Geometry where
    glibType :: IO GType
glibType = IO GType
c_clutter_geometry_get_type

instance B.Types.GBoxed Geometry

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

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

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


-- | Get the value of the “@x@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' geometry #x
-- @
getGeometryX :: MonadIO m => Geometry -> m Int32
getGeometryX :: forall (m :: * -> *). MonadIO m => Geometry -> m Int32
getGeometryX Geometry
s = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ Geometry -> (Ptr Geometry -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Geometry
s ((Ptr Geometry -> IO Int32) -> IO Int32)
-> (Ptr Geometry -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \Ptr Geometry
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Geometry
ptr Ptr Geometry -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO Int32
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
val

-- | Set the value of the “@x@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' geometry [ #x 'Data.GI.Base.Attributes.:=' value ]
-- @
setGeometryX :: MonadIO m => Geometry -> Int32 -> m ()
setGeometryX :: forall (m :: * -> *). MonadIO m => Geometry -> Int32 -> m ()
setGeometryX Geometry
s Int32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Geometry -> (Ptr Geometry -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Geometry
s ((Ptr Geometry -> IO ()) -> IO ())
-> (Ptr Geometry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Geometry
ptr -> do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Geometry
ptr Ptr Geometry -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (Int32
val :: Int32)

#if defined(ENABLE_OVERLOADING)
data GeometryXFieldInfo
instance AttrInfo GeometryXFieldInfo where
    type AttrBaseTypeConstraint GeometryXFieldInfo = (~) Geometry
    type AttrAllowedOps GeometryXFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint GeometryXFieldInfo = (~) Int32
    type AttrTransferTypeConstraint GeometryXFieldInfo = (~)Int32
    type AttrTransferType GeometryXFieldInfo = Int32
    type AttrGetType GeometryXFieldInfo = Int32
    type AttrLabel GeometryXFieldInfo = "x"
    type AttrOrigin GeometryXFieldInfo = Geometry
    attrGet = getGeometryX
    attrSet = setGeometryX
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.Geometry.x"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Structs-Geometry.html#g:attr:x"
        })

geometry_x :: AttrLabelProxy "x"
geometry_x = AttrLabelProxy

#endif


-- | Get the value of the “@y@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' geometry #y
-- @
getGeometryY :: MonadIO m => Geometry -> m Int32
getGeometryY :: forall (m :: * -> *). MonadIO m => Geometry -> m Int32
getGeometryY Geometry
s = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ Geometry -> (Ptr Geometry -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Geometry
s ((Ptr Geometry -> IO Int32) -> IO Int32)
-> (Ptr Geometry -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \Ptr Geometry
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Geometry
ptr Ptr Geometry -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4) :: IO Int32
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
val

-- | Set the value of the “@y@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' geometry [ #y 'Data.GI.Base.Attributes.:=' value ]
-- @
setGeometryY :: MonadIO m => Geometry -> Int32 -> m ()
setGeometryY :: forall (m :: * -> *). MonadIO m => Geometry -> Int32 -> m ()
setGeometryY Geometry
s Int32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Geometry -> (Ptr Geometry -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Geometry
s ((Ptr Geometry -> IO ()) -> IO ())
-> (Ptr Geometry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Geometry
ptr -> do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Geometry
ptr Ptr Geometry -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4) (Int32
val :: Int32)

#if defined(ENABLE_OVERLOADING)
data GeometryYFieldInfo
instance AttrInfo GeometryYFieldInfo where
    type AttrBaseTypeConstraint GeometryYFieldInfo = (~) Geometry
    type AttrAllowedOps GeometryYFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint GeometryYFieldInfo = (~) Int32
    type AttrTransferTypeConstraint GeometryYFieldInfo = (~)Int32
    type AttrTransferType GeometryYFieldInfo = Int32
    type AttrGetType GeometryYFieldInfo = Int32
    type AttrLabel GeometryYFieldInfo = "y"
    type AttrOrigin GeometryYFieldInfo = Geometry
    attrGet = getGeometryY
    attrSet = setGeometryY
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.Geometry.y"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Structs-Geometry.html#g:attr:y"
        })

geometry_y :: AttrLabelProxy "y"
geometry_y = AttrLabelProxy

#endif


-- | Get the value of the “@width@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' geometry #width
-- @
getGeometryWidth :: MonadIO m => Geometry -> m Word32
getGeometryWidth :: forall (m :: * -> *). MonadIO m => Geometry -> m Word32
getGeometryWidth Geometry
s = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ Geometry -> (Ptr Geometry -> IO Word32) -> IO Word32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Geometry
s ((Ptr Geometry -> IO Word32) -> IO Word32)
-> (Ptr Geometry -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \Ptr Geometry
ptr -> do
    Word32
val <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Geometry
ptr Ptr Geometry -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO Word32
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
val

-- | Set the value of the “@width@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' geometry [ #width 'Data.GI.Base.Attributes.:=' value ]
-- @
setGeometryWidth :: MonadIO m => Geometry -> Word32 -> m ()
setGeometryWidth :: forall (m :: * -> *). MonadIO m => Geometry -> Word32 -> m ()
setGeometryWidth Geometry
s Word32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Geometry -> (Ptr Geometry -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Geometry
s ((Ptr Geometry -> IO ()) -> IO ())
-> (Ptr Geometry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Geometry
ptr -> do
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Geometry
ptr Ptr Geometry -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (Word32
val :: Word32)

#if defined(ENABLE_OVERLOADING)
data GeometryWidthFieldInfo
instance AttrInfo GeometryWidthFieldInfo where
    type AttrBaseTypeConstraint GeometryWidthFieldInfo = (~) Geometry
    type AttrAllowedOps GeometryWidthFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint GeometryWidthFieldInfo = (~) Word32
    type AttrTransferTypeConstraint GeometryWidthFieldInfo = (~)Word32
    type AttrTransferType GeometryWidthFieldInfo = Word32
    type AttrGetType GeometryWidthFieldInfo = Word32
    type AttrLabel GeometryWidthFieldInfo = "width"
    type AttrOrigin GeometryWidthFieldInfo = Geometry
    attrGet = getGeometryWidth
    attrSet = setGeometryWidth
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.Geometry.width"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Structs-Geometry.html#g:attr:width"
        })

geometry_width :: AttrLabelProxy "width"
geometry_width = AttrLabelProxy

#endif


-- | Get the value of the “@height@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' geometry #height
-- @
getGeometryHeight :: MonadIO m => Geometry -> m Word32
getGeometryHeight :: forall (m :: * -> *). MonadIO m => Geometry -> m Word32
getGeometryHeight Geometry
s = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ Geometry -> (Ptr Geometry -> IO Word32) -> IO Word32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Geometry
s ((Ptr Geometry -> IO Word32) -> IO Word32)
-> (Ptr Geometry -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \Ptr Geometry
ptr -> do
    Word32
val <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Geometry
ptr Ptr Geometry -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12) :: IO Word32
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
val

-- | Set the value of the “@height@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' geometry [ #height 'Data.GI.Base.Attributes.:=' value ]
-- @
setGeometryHeight :: MonadIO m => Geometry -> Word32 -> m ()
setGeometryHeight :: forall (m :: * -> *). MonadIO m => Geometry -> Word32 -> m ()
setGeometryHeight Geometry
s Word32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Geometry -> (Ptr Geometry -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Geometry
s ((Ptr Geometry -> IO ()) -> IO ())
-> (Ptr Geometry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Geometry
ptr -> do
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Geometry
ptr Ptr Geometry -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12) (Word32
val :: Word32)

#if defined(ENABLE_OVERLOADING)
data GeometryHeightFieldInfo
instance AttrInfo GeometryHeightFieldInfo where
    type AttrBaseTypeConstraint GeometryHeightFieldInfo = (~) Geometry
    type AttrAllowedOps GeometryHeightFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint GeometryHeightFieldInfo = (~) Word32
    type AttrTransferTypeConstraint GeometryHeightFieldInfo = (~)Word32
    type AttrTransferType GeometryHeightFieldInfo = Word32
    type AttrGetType GeometryHeightFieldInfo = Word32
    type AttrLabel GeometryHeightFieldInfo = "height"
    type AttrOrigin GeometryHeightFieldInfo = Geometry
    attrGet = getGeometryHeight
    attrSet = setGeometryHeight
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.Geometry.height"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Structs-Geometry.html#g:attr:height"
        })

geometry_height :: AttrLabelProxy "height"
geometry_height = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Geometry
type instance O.AttributeList Geometry = GeometryAttributeList
type GeometryAttributeList = ('[ '("x", GeometryXFieldInfo), '("y", GeometryYFieldInfo), '("width", GeometryWidthFieldInfo), '("height", GeometryHeightFieldInfo)] :: [(Symbol, *)])
#endif

-- method Geometry::intersects
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "geometry0"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Geometry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The first geometry to test"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "geometry1"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Geometry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The second geometry to test"
--                 , 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_geometry_intersects" clutter_geometry_intersects :: 
    Ptr Geometry ->                         -- geometry0 : TInterface (Name {namespace = "Clutter", name = "Geometry"})
    Ptr Geometry ->                         -- geometry1 : TInterface (Name {namespace = "Clutter", name = "Geometry"})
    IO CInt

{-# DEPRECATED geometryIntersects ["(Since version 1.16)","Use t'GI.Clutter.Structs.Rect.Rect' and 'GI.Clutter.Structs.Rect.rectIntersection'"] #-}
-- | Determines if /@geometry0@/ and geometry1 intersect returning 'P.True' if
-- they do else 'P.False'.
-- 
-- /Since: 1.4/
geometryIntersects ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Geometry
    -- ^ /@geometry0@/: The first geometry to test
    -> Geometry
    -- ^ /@geometry1@/: The second geometry to test
    -> m Bool
    -- ^ __Returns:__ 'P.True' of /@geometry0@/ and geometry1 intersect else
    -- 'P.False'.
geometryIntersects :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Geometry -> Geometry -> m Bool
geometryIntersects Geometry
geometry0 Geometry
geometry1 = IO Bool -> m Bool
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 Geometry
geometry0' <- Geometry -> IO (Ptr Geometry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Geometry
geometry0
    Ptr Geometry
geometry1' <- Geometry -> IO (Ptr Geometry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Geometry
geometry1
    CInt
result <- Ptr Geometry -> Ptr Geometry -> IO CInt
clutter_geometry_intersects Ptr Geometry
geometry0' Ptr Geometry
geometry1'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Geometry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Geometry
geometry0
    Geometry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Geometry
geometry1
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data GeometryIntersectsMethodInfo
instance (signature ~ (Geometry -> m Bool), MonadIO m) => O.OverloadedMethod GeometryIntersectsMethodInfo Geometry signature where
    overloadedMethod = geometryIntersects

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


#endif

-- method Geometry::union
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "geometry_a"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Geometry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterGeometry" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "geometry_b"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Geometry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "another #ClutterGeometry"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Geometry" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location to store the result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_geometry_union" clutter_geometry_union :: 
    Ptr Geometry ->                         -- geometry_a : TInterface (Name {namespace = "Clutter", name = "Geometry"})
    Ptr Geometry ->                         -- geometry_b : TInterface (Name {namespace = "Clutter", name = "Geometry"})
    Ptr Geometry ->                         -- result : TInterface (Name {namespace = "Clutter", name = "Geometry"})
    IO ()

{-# DEPRECATED geometryUnion ["(Since version 1.16)","Use t'GI.Clutter.Structs.Rect.Rect' and 'GI.Clutter.Structs.Rect.rectUnion'"] #-}
-- | Find the union of two rectangles represented as t'GI.Clutter.Structs.Geometry.Geometry'.
-- 
-- /Since: 1.4/
geometryUnion ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Geometry
    -- ^ /@geometryA@/: a t'GI.Clutter.Structs.Geometry.Geometry'
    -> Geometry
    -- ^ /@geometryB@/: another t'GI.Clutter.Structs.Geometry.Geometry'
    -> m (Geometry)
geometryUnion :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Geometry -> Geometry -> m Geometry
geometryUnion Geometry
geometryA Geometry
geometryB = IO Geometry -> m Geometry
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Geometry -> m Geometry) -> IO Geometry -> m Geometry
forall a b. (a -> b) -> a -> b
$ do
    Ptr Geometry
geometryA' <- Geometry -> IO (Ptr Geometry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Geometry
geometryA
    Ptr Geometry
geometryB' <- Geometry -> IO (Ptr Geometry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Geometry
geometryB
    Ptr Geometry
result_ <- Int -> IO (Ptr Geometry)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
16 :: IO (Ptr Geometry)
    Ptr Geometry -> Ptr Geometry -> Ptr Geometry -> IO ()
clutter_geometry_union Ptr Geometry
geometryA' Ptr Geometry
geometryB' Ptr Geometry
result_
    Geometry
result_' <- ((ManagedPtr Geometry -> Geometry) -> Ptr Geometry -> IO Geometry
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Geometry -> Geometry
Geometry) Ptr Geometry
result_
    Geometry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Geometry
geometryA
    Geometry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Geometry
geometryB
    Geometry -> IO Geometry
forall (m :: * -> *) a. Monad m => a -> m a
return Geometry
result_'

#if defined(ENABLE_OVERLOADING)
data GeometryUnionMethodInfo
instance (signature ~ (Geometry -> m (Geometry)), MonadIO m) => O.OverloadedMethod GeometryUnionMethodInfo Geometry signature where
    overloadedMethod = geometryUnion

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


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveGeometryMethod (t :: Symbol) (o :: *) :: * where
    ResolveGeometryMethod "intersects" o = GeometryIntersectsMethodInfo
    ResolveGeometryMethod "union" o = GeometryUnionMethodInfo
    ResolveGeometryMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif