{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A t'GI.Vips.Structs.Rect.Rect' is a rectangular area of pixels. This is a struct for
-- performing simple rectangle algebra.

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

module GI.Vips.Structs.Rect
    ( 

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


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [includespoint]("GI.Vips.Structs.Rect#g:method:includespoint"), [intersectrect]("GI.Vips.Structs.Rect#g:method:intersectrect"), [rectEqualsrect]("GI.Vips.Structs.Rect#g:method:rectEqualsrect"), [rectIncludesrect]("GI.Vips.Structs.Rect#g:method:rectIncludesrect"), [rectIsempty]("GI.Vips.Structs.Rect#g:method:rectIsempty"), [rectMarginadjust]("GI.Vips.Structs.Rect#g:method:rectMarginadjust"), [rectNormalise]("GI.Vips.Structs.Rect#g:method:rectNormalise"), [rectOverlapsrect]("GI.Vips.Structs.Rect#g:method:rectOverlapsrect"), [unionrect]("GI.Vips.Structs.Rect#g:method:unionrect").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveRectMethod                       ,
#endif

-- ** includespoint #method:includespoint#

#if defined(ENABLE_OVERLOADING)
    RectIncludespointMethodInfo             ,
#endif
    rectIncludespoint                       ,


-- ** intersectrect #method:intersectrect#

#if defined(ENABLE_OVERLOADING)
    RectIntersectrectMethodInfo             ,
#endif
    rectIntersectrect                       ,


-- ** rectEqualsrect #method:rectEqualsrect#

#if defined(ENABLE_OVERLOADING)
    RectRectEqualsrectMethodInfo            ,
#endif
    rectRectEqualsrect                      ,


-- ** rectIncludesrect #method:rectIncludesrect#

#if defined(ENABLE_OVERLOADING)
    RectRectIncludesrectMethodInfo          ,
#endif
    rectRectIncludesrect                    ,


-- ** rectIsempty #method:rectIsempty#

#if defined(ENABLE_OVERLOADING)
    RectRectIsemptyMethodInfo               ,
#endif
    rectRectIsempty                         ,


-- ** rectMarginadjust #method:rectMarginadjust#

#if defined(ENABLE_OVERLOADING)
    RectRectMarginadjustMethodInfo          ,
#endif
    rectRectMarginadjust                    ,


-- ** rectNormalise #method:rectNormalise#

#if defined(ENABLE_OVERLOADING)
    RectRectNormaliseMethodInfo             ,
#endif
    rectRectNormalise                       ,


-- ** rectOverlapsrect #method:rectOverlapsrect#

#if defined(ENABLE_OVERLOADING)
    RectRectOverlapsrectMethodInfo          ,
#endif
    rectRectOverlapsrect                    ,


-- ** unionrect #method:unionrect#

#if defined(ENABLE_OVERLOADING)
    RectUnionrectMethodInfo                 ,
#endif
    rectUnionrect                           ,




 -- * Properties


-- ** height #attr:height#
-- | height of rectangle

    getRectHeight                           ,
#if defined(ENABLE_OVERLOADING)
    rect_height                             ,
#endif
    setRectHeight                           ,


-- ** left #attr:left#
-- | left edge of rectangle

    getRectLeft                             ,
#if defined(ENABLE_OVERLOADING)
    rect_left                               ,
#endif
    setRectLeft                             ,


-- ** top #attr:top#
-- | top edge of rectangle

    getRectTop                              ,
#if defined(ENABLE_OVERLOADING)
    rect_top                                ,
#endif
    setRectTop                              ,


-- ** width #attr:width#
-- | width of rectangle

    getRectWidth                            ,
#if defined(ENABLE_OVERLOADING)
    rect_width                              ,
#endif
    setRectWidth                            ,




    ) 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 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
/= :: Rect -> Rect -> Bool
$c/= :: Rect -> Rect -> Bool
== :: Rect -> Rect -> Bool
$c== :: Rect -> Rect -> Bool
Eq)

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

instance BoxedPtr Rect where
    boxedPtrCopy :: Rect -> IO Rect
boxedPtrCopy = \Rect
p -> Rect -> (Ptr Rect -> IO Rect) -> IO Rect
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Rect
p (Int -> Ptr Rect -> IO (Ptr Rect)
forall a. (HasCallStack, CallocPtr a) => Int -> Ptr a -> IO (Ptr a)
copyBytes Int
16 (Ptr Rect -> IO (Ptr Rect))
-> (Ptr Rect -> IO Rect) -> Ptr Rect -> IO Rect
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ManagedPtr Rect -> Rect) -> Ptr Rect -> IO Rect
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.wrapPtr ManagedPtr Rect -> Rect
Rect)
    boxedPtrFree :: Rect -> IO ()
boxedPtrFree = \Rect
x -> Rect -> (Ptr Rect -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
SP.withManagedPtr Rect
x Ptr Rect -> IO ()
forall a. Ptr a -> IO ()
SP.freeMem
instance CallocPtr Rect where
    boxedPtrCalloc :: IO (Ptr Rect)
boxedPtrCalloc = Int -> IO (Ptr Rect)
forall a. Int -> IO (Ptr a)
callocBytes Int
16


-- | 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 (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Rect -> m Rect) -> IO Rect -> m Rect
forall a b. (a -> b) -> a -> b
$ IO (Ptr Rect)
forall a. CallocPtr a => IO (Ptr a)
boxedPtrCalloc IO (Ptr Rect) -> (Ptr Rect -> IO Rect) -> IO Rect
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr Rect -> Rect) -> Ptr Rect -> IO Rect
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr 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 (m :: * -> *) a. Monad m => a -> m a
return Rect
o


-- | Get the value of the “@left@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' rect #left
-- @
getRectLeft :: MonadIO m => Rect -> m Int32
getRectLeft :: forall (m :: * -> *). MonadIO m => Rect -> m Int32
getRectLeft Rect
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
$ Rect -> (Ptr Rect -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Rect
s ((Ptr Rect -> IO Int32) -> IO Int32)
-> (Ptr Rect -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \Ptr Rect
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Rect
ptr Ptr Rect -> 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 “@left@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' rect [ #left 'Data.GI.Base.Attributes.:=' value ]
-- @
setRectLeft :: MonadIO m => Rect -> Int32 -> m ()
setRectLeft :: forall (m :: * -> *). MonadIO m => Rect -> Int32 -> m ()
setRectLeft Rect
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
$ Rect -> (Ptr Rect -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Rect
s ((Ptr Rect -> IO ()) -> IO ()) -> (Ptr Rect -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Rect
ptr -> do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Rect
ptr Ptr Rect -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (Int32
val :: Int32)

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

rect_left :: AttrLabelProxy "left"
rect_left = AttrLabelProxy

#endif


-- | Get the value of the “@top@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' rect #top
-- @
getRectTop :: MonadIO m => Rect -> m Int32
getRectTop :: forall (m :: * -> *). MonadIO m => Rect -> m Int32
getRectTop Rect
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
$ Rect -> (Ptr Rect -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Rect
s ((Ptr Rect -> IO Int32) -> IO Int32)
-> (Ptr Rect -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \Ptr Rect
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Rect
ptr Ptr Rect -> 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 “@top@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' rect [ #top 'Data.GI.Base.Attributes.:=' value ]
-- @
setRectTop :: MonadIO m => Rect -> Int32 -> m ()
setRectTop :: forall (m :: * -> *). MonadIO m => Rect -> Int32 -> m ()
setRectTop Rect
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
$ Rect -> (Ptr Rect -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Rect
s ((Ptr Rect -> IO ()) -> IO ()) -> (Ptr Rect -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Rect
ptr -> do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Rect
ptr Ptr Rect -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4) (Int32
val :: Int32)

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

rect_top :: AttrLabelProxy "top"
rect_top = 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' rect #width
-- @
getRectWidth :: MonadIO m => Rect -> m Int32
getRectWidth :: forall (m :: * -> *). MonadIO m => Rect -> m Int32
getRectWidth Rect
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
$ Rect -> (Ptr Rect -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Rect
s ((Ptr Rect -> IO Int32) -> IO Int32)
-> (Ptr Rect -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \Ptr Rect
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Rect
ptr Ptr Rect -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO Int32
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
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' rect [ #width 'Data.GI.Base.Attributes.:=' value ]
-- @
setRectWidth :: MonadIO m => Rect -> Int32 -> m ()
setRectWidth :: forall (m :: * -> *). MonadIO m => Rect -> Int32 -> m ()
setRectWidth Rect
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
$ Rect -> (Ptr Rect -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Rect
s ((Ptr Rect -> IO ()) -> IO ()) -> (Ptr Rect -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Rect
ptr -> do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Rect
ptr Ptr Rect -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (Int32
val :: Int32)

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

rect_width :: AttrLabelProxy "width"
rect_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' rect #height
-- @
getRectHeight :: MonadIO m => Rect -> m Int32
getRectHeight :: forall (m :: * -> *). MonadIO m => Rect -> m Int32
getRectHeight Rect
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
$ Rect -> (Ptr Rect -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Rect
s ((Ptr Rect -> IO Int32) -> IO Int32)
-> (Ptr Rect -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \Ptr Rect
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Rect
ptr Ptr Rect -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12) :: IO Int32
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
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' rect [ #height 'Data.GI.Base.Attributes.:=' value ]
-- @
setRectHeight :: MonadIO m => Rect -> Int32 -> m ()
setRectHeight :: forall (m :: * -> *). MonadIO m => Rect -> Int32 -> m ()
setRectHeight Rect
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
$ Rect -> (Ptr Rect -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Rect
s ((Ptr Rect -> IO ()) -> IO ()) -> (Ptr Rect -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Rect
ptr -> do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Rect
ptr Ptr Rect -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12) (Int32
val :: Int32)

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

rect_height :: AttrLabelProxy "height"
rect_height = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Rect
type instance O.AttributeList Rect = RectAttributeList
type RectAttributeList = ('[ '("left", RectLeftFieldInfo), '("top", RectTopFieldInfo), '("width", RectWidthFieldInfo), '("height", RectHeightFieldInfo)] :: [(Symbol, *)])
#endif

-- method Rect::includespoint
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "r"
--           , argType = TInterface Name { namespace = "Vips" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "rectangle to test" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "position to test for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "position to test for"
--                 , 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 "vips_rect_includespoint" vips_rect_includespoint :: 
    Ptr Rect ->                             -- r : TInterface (Name {namespace = "Vips", name = "Rect"})
    Int32 ->                                -- x : TBasicType TInt
    Int32 ->                                -- y : TBasicType TInt
    IO CInt

-- | Does /@r@/ contain point (/@x@/, /@y@/)?
rectIncludespoint ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Rect
    -- ^ /@r@/: rectangle to test
    -> Int32
    -- ^ /@x@/: position to test for
    -> Int32
    -- ^ /@y@/: position to test for
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@r@/ contains (/@x@/, /@y@/).
rectIncludespoint :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Rect -> Int32 -> Int32 -> m Bool
rectIncludespoint Rect
r Int32
x Int32
y = 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 Rect
r' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
r
    CInt
result <- Ptr Rect -> Int32 -> Int32 -> IO CInt
vips_rect_includespoint Ptr Rect
r' Int32
x Int32
y
    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
r
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

instance O.OverloadedMethodInfo RectIncludespointMethodInfo Rect where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Structs.Rect.rectIncludespoint",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.2/docs/GI-Vips-Structs-Rect.html#v:rectIncludespoint"
        })


#endif

-- method Rect::intersectrect
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "r1"
--           , argType = TInterface Name { namespace = "Vips" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input rectangle 1" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "r2"
--           , argType = TInterface Name { namespace = "Vips" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input rectangle 2" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out"
--           , argType = TInterface Name { namespace = "Vips" , name = "Rect" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "output rectangle" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "vips_rect_intersectrect" vips_rect_intersectrect :: 
    Ptr Rect ->                             -- r1 : TInterface (Name {namespace = "Vips", name = "Rect"})
    Ptr Rect ->                             -- r2 : TInterface (Name {namespace = "Vips", name = "Rect"})
    Ptr Rect ->                             -- out : TInterface (Name {namespace = "Vips", name = "Rect"})
    IO ()

-- | Fill /@out@/ with the intersection of /@r1@/ and /@r2@/. /@out@/ can equal /@r1@/ or /@r2@/.
rectIntersectrect ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Rect
    -- ^ /@r1@/: input rectangle 1
    -> Rect
    -- ^ /@r2@/: input rectangle 2
    -> m (Rect)
rectIntersectrect :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Rect -> Rect -> m Rect
rectIntersectrect Rect
r1 Rect
r2 = IO Rect -> m Rect
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
r1' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
r1
    Ptr Rect
r2' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
r2
    Ptr Rect
out <- Int -> IO (Ptr Rect)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
16 :: IO (Ptr Rect)
    Ptr Rect -> Ptr Rect -> Ptr Rect -> IO ()
vips_rect_intersectrect Ptr Rect
r1' Ptr Rect
r2' Ptr Rect
out
    Rect
out' <- ((ManagedPtr Rect -> Rect) -> Ptr Rect -> IO Rect
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr Rect -> Rect
Rect) Ptr Rect
out
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
r1
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
r2
    Rect -> IO Rect
forall (m :: * -> *) a. Monad m => a -> m a
return Rect
out'

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

instance O.OverloadedMethodInfo RectIntersectrectMethodInfo Rect where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Structs.Rect.rectIntersectrect",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.2/docs/GI-Vips-Structs-Rect.html#v:rectIntersectrect"
        })


#endif

-- method Rect::rect_equalsrect
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "r1"
--           , argType = TInterface Name { namespace = "Vips" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "first rectangle" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "r2"
--           , argType = TInterface Name { namespace = "Vips" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "second rectangle" , 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 "vips_rect_equalsrect" vips_rect_equalsrect :: 
    Ptr Rect ->                             -- r1 : TInterface (Name {namespace = "Vips", name = "Rect"})
    Ptr Rect ->                             -- r2 : TInterface (Name {namespace = "Vips", name = "Rect"})
    IO CInt

-- | Is /@r1@/ equal to /@r2@/?
rectRectEqualsrect ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Rect
    -- ^ /@r1@/: first rectangle
    -> Rect
    -- ^ /@r2@/: second rectangle
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@r1@/ is equal to /@r2@/.
rectRectEqualsrect :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Rect -> Rect -> m Bool
rectRectEqualsrect Rect
r1 Rect
r2 = 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 Rect
r1' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
r1
    Ptr Rect
r2' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
r2
    CInt
result <- Ptr Rect -> Ptr Rect -> IO CInt
vips_rect_equalsrect Ptr Rect
r1' Ptr Rect
r2'
    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
r1
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
r2
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

instance O.OverloadedMethodInfo RectRectEqualsrectMethodInfo Rect where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Structs.Rect.rectRectEqualsrect",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.2/docs/GI-Vips-Structs-Rect.html#v:rectRectEqualsrect"
        })


#endif

-- method Rect::rect_includesrect
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "r1"
--           , argType = TInterface Name { namespace = "Vips" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "outer rectangle" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "r2"
--           , argType = TInterface Name { namespace = "Vips" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "inner rectangle" , 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 "vips_rect_includesrect" vips_rect_includesrect :: 
    Ptr Rect ->                             -- r1 : TInterface (Name {namespace = "Vips", name = "Rect"})
    Ptr Rect ->                             -- r2 : TInterface (Name {namespace = "Vips", name = "Rect"})
    IO CInt

-- | Is /@r2@/ a subset of /@r1@/?
rectRectIncludesrect ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Rect
    -- ^ /@r1@/: outer rectangle
    -> Rect
    -- ^ /@r2@/: inner rectangle
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@r2@/ is a subset of /@r1@/.
rectRectIncludesrect :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Rect -> Rect -> m Bool
rectRectIncludesrect Rect
r1 Rect
r2 = 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 Rect
r1' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
r1
    Ptr Rect
r2' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
r2
    CInt
result <- Ptr Rect -> Ptr Rect -> IO CInt
vips_rect_includesrect Ptr Rect
r1' Ptr Rect
r2'
    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
r1
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
r2
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

instance O.OverloadedMethodInfo RectRectIncludesrectMethodInfo Rect where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Structs.Rect.rectRectIncludesrect",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.2/docs/GI-Vips-Structs-Rect.html#v:rectRectIncludesrect"
        })


#endif

-- method Rect::rect_isempty
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "r"
--           , argType = TInterface Name { namespace = "Vips" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "rectangle 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 "vips_rect_isempty" vips_rect_isempty :: 
    Ptr Rect ->                             -- r : TInterface (Name {namespace = "Vips", name = "Rect"})
    IO CInt

-- | Is /@r@/ empty? ie. zero width or height.
rectRectIsempty ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Rect
    -- ^ /@r@/: rectangle to test
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@r@/ contains no pixels.
rectRectIsempty :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Rect -> m Bool
rectRectIsempty Rect
r = 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 Rect
r' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
r
    CInt
result <- Ptr Rect -> IO CInt
vips_rect_isempty Ptr Rect
r'
    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
r
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

instance O.OverloadedMethodInfo RectRectIsemptyMethodInfo Rect where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Structs.Rect.rectRectIsempty",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.2/docs/GI-Vips-Structs-Rect.html#v:rectRectIsempty"
        })


#endif

-- method Rect::rect_marginadjust
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "r"
--           , argType = TInterface Name { namespace = "Vips" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "rectangle to adjust"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "enlarge by" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "vips_rect_marginadjust" vips_rect_marginadjust :: 
    Ptr Rect ->                             -- r : TInterface (Name {namespace = "Vips", name = "Rect"})
    Int32 ->                                -- n : TBasicType TInt
    IO ()

-- | Enlarge /@r@/ by /@n@/. +1 means out one pixel.
rectRectMarginadjust ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Rect
    -- ^ /@r@/: rectangle to adjust
    -> Int32
    -- ^ /@n@/: enlarge by
    -> m ()
rectRectMarginadjust :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Rect -> Int32 -> m ()
rectRectMarginadjust Rect
r Int32
n = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Rect
r' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
r
    Ptr Rect -> Int32 -> IO ()
vips_rect_marginadjust Ptr Rect
r' Int32
n
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
r
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo RectRectMarginadjustMethodInfo Rect where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Structs.Rect.rectRectMarginadjust",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.2/docs/GI-Vips-Structs-Rect.html#v:rectRectMarginadjust"
        })


#endif

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

foreign import ccall "vips_rect_normalise" vips_rect_normalise :: 
    Ptr Rect ->                             -- r : TInterface (Name {namespace = "Vips", name = "Rect"})
    IO ()

-- | Make sure width and height are >0 by moving the origin and flipping the
-- rect.
rectRectNormalise ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Rect
    -- ^ /@r@/: rect to normalise
    -> m ()
rectRectNormalise :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Rect -> m ()
rectRectNormalise Rect
r = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Rect
r' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
r
    Ptr Rect -> IO ()
vips_rect_normalise Ptr Rect
r'
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
r
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo RectRectNormaliseMethodInfo Rect where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Structs.Rect.rectRectNormalise",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.2/docs/GI-Vips-Structs-Rect.html#v:rectRectNormalise"
        })


#endif

-- method Rect::rect_overlapsrect
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "r1"
--           , argType = TInterface Name { namespace = "Vips" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "first rectangle" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "r2"
--           , argType = TInterface Name { namespace = "Vips" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "second rectangle" , 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 "vips_rect_overlapsrect" vips_rect_overlapsrect :: 
    Ptr Rect ->                             -- r1 : TInterface (Name {namespace = "Vips", name = "Rect"})
    Ptr Rect ->                             -- r2 : TInterface (Name {namespace = "Vips", name = "Rect"})
    IO CInt

-- | Do /@r1@/ and /@r2@/ have a non-empty intersection?
rectRectOverlapsrect ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Rect
    -- ^ /@r1@/: first rectangle
    -> Rect
    -- ^ /@r2@/: second rectangle
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@r2@/ and /@r1@/ overlap.
rectRectOverlapsrect :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Rect -> Rect -> m Bool
rectRectOverlapsrect Rect
r1 Rect
r2 = 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 Rect
r1' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
r1
    Ptr Rect
r2' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
r2
    CInt
result <- Ptr Rect -> Ptr Rect -> IO CInt
vips_rect_overlapsrect Ptr Rect
r1' Ptr Rect
r2'
    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
r1
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
r2
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

instance O.OverloadedMethodInfo RectRectOverlapsrectMethodInfo Rect where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Structs.Rect.rectRectOverlapsrect",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.2/docs/GI-Vips-Structs-Rect.html#v:rectRectOverlapsrect"
        })


#endif

-- method Rect::unionrect
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "r1"
--           , argType = TInterface Name { namespace = "Vips" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input rectangle 1" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "r2"
--           , argType = TInterface Name { namespace = "Vips" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input rectangle 2" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out"
--           , argType = TInterface Name { namespace = "Vips" , name = "Rect" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "output rectangle" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "vips_rect_unionrect" vips_rect_unionrect :: 
    Ptr Rect ->                             -- r1 : TInterface (Name {namespace = "Vips", name = "Rect"})
    Ptr Rect ->                             -- r2 : TInterface (Name {namespace = "Vips", name = "Rect"})
    Ptr Rect ->                             -- out : TInterface (Name {namespace = "Vips", name = "Rect"})
    IO ()

-- | Fill /@out@/ with the bounding box of /@r1@/ and /@r2@/. /@out@/ can equal /@r1@/ or /@r2@/.
rectUnionrect ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Rect
    -- ^ /@r1@/: input rectangle 1
    -> Rect
    -- ^ /@r2@/: input rectangle 2
    -> m (Rect)
rectUnionrect :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Rect -> Rect -> m Rect
rectUnionrect Rect
r1 Rect
r2 = IO Rect -> m Rect
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
r1' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
r1
    Ptr Rect
r2' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
r2
    Ptr Rect
out <- Int -> IO (Ptr Rect)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
16 :: IO (Ptr Rect)
    Ptr Rect -> Ptr Rect -> Ptr Rect -> IO ()
vips_rect_unionrect Ptr Rect
r1' Ptr Rect
r2' Ptr Rect
out
    Rect
out' <- ((ManagedPtr Rect -> Rect) -> Ptr Rect -> IO Rect
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr Rect -> Rect
Rect) Ptr Rect
out
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
r1
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
r2
    Rect -> IO Rect
forall (m :: * -> *) a. Monad m => a -> m a
return Rect
out'

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

instance O.OverloadedMethodInfo RectUnionrectMethodInfo Rect where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Structs.Rect.rectUnionrect",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.2/docs/GI-Vips-Structs-Rect.html#v:rectUnionrect"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveRectMethod (t :: Symbol) (o :: *) :: * where
    ResolveRectMethod "includespoint" o = RectIncludespointMethodInfo
    ResolveRectMethod "intersectrect" o = RectIntersectrectMethodInfo
    ResolveRectMethod "rectEqualsrect" o = RectRectEqualsrectMethodInfo
    ResolveRectMethod "rectIncludesrect" o = RectRectIncludesrectMethodInfo
    ResolveRectMethod "rectIsempty" o = RectRectIsemptyMethodInfo
    ResolveRectMethod "rectMarginadjust" o = RectRectMarginadjustMethodInfo
    ResolveRectMethod "rectNormalise" o = RectRectNormaliseMethodInfo
    ResolveRectMethod "rectOverlapsrect" o = RectRectOverlapsrectMethodInfo
    ResolveRectMethod "unionrect" o = RectUnionrectMethodInfo
    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