{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A rectangular region with rounded corners.
-- 
-- Application code should normalize rectangles using
-- 'GI.Gsk.Structs.RoundedRect.roundedRectNormalize'; this function will ensure that
-- the bounds of the rectangle are normalized and ensure that the corner
-- values are positive and the corners do not overlap.
-- 
-- All functions taking a @GskRoundedRect@ as an argument will internally
-- operate on a normalized copy; all functions returning a @GskRoundedRect@
-- will always return a normalized one.
-- 
-- The algorithm used for normalizing corner sizes is described in
-- <https://drafts.csswg.org/css-backgrounds-3/#border-radius the CSS specification>.

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

module GI.Gsk.Structs.RoundedRect
    ( 

-- * Exported types
    RoundedRect(..)                         ,
    newZeroRoundedRect                      ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [containsPoint]("GI.Gsk.Structs.RoundedRect#g:method:containsPoint"), [containsRect]("GI.Gsk.Structs.RoundedRect#g:method:containsRect"), [init]("GI.Gsk.Structs.RoundedRect#g:method:init"), [initCopy]("GI.Gsk.Structs.RoundedRect#g:method:initCopy"), [initFromRect]("GI.Gsk.Structs.RoundedRect#g:method:initFromRect"), [intersectsRect]("GI.Gsk.Structs.RoundedRect#g:method:intersectsRect"), [isRectilinear]("GI.Gsk.Structs.RoundedRect#g:method:isRectilinear"), [normalize]("GI.Gsk.Structs.RoundedRect#g:method:normalize"), [offset]("GI.Gsk.Structs.RoundedRect#g:method:offset"), [shrink]("GI.Gsk.Structs.RoundedRect#g:method:shrink").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveRoundedRectMethod                ,
#endif

-- ** containsPoint #method:containsPoint#

#if defined(ENABLE_OVERLOADING)
    RoundedRectContainsPointMethodInfo      ,
#endif
    roundedRectContainsPoint                ,


-- ** containsRect #method:containsRect#

#if defined(ENABLE_OVERLOADING)
    RoundedRectContainsRectMethodInfo       ,
#endif
    roundedRectContainsRect                 ,


-- ** init #method:init#

#if defined(ENABLE_OVERLOADING)
    RoundedRectInitMethodInfo               ,
#endif
    roundedRectInit                         ,


-- ** initCopy #method:initCopy#

#if defined(ENABLE_OVERLOADING)
    RoundedRectInitCopyMethodInfo           ,
#endif
    roundedRectInitCopy                     ,


-- ** initFromRect #method:initFromRect#

#if defined(ENABLE_OVERLOADING)
    RoundedRectInitFromRectMethodInfo       ,
#endif
    roundedRectInitFromRect                 ,


-- ** intersectsRect #method:intersectsRect#

#if defined(ENABLE_OVERLOADING)
    RoundedRectIntersectsRectMethodInfo     ,
#endif
    roundedRectIntersectsRect               ,


-- ** isRectilinear #method:isRectilinear#

#if defined(ENABLE_OVERLOADING)
    RoundedRectIsRectilinearMethodInfo      ,
#endif
    roundedRectIsRectilinear                ,


-- ** normalize #method:normalize#

#if defined(ENABLE_OVERLOADING)
    RoundedRectNormalizeMethodInfo          ,
#endif
    roundedRectNormalize                    ,


-- ** offset #method:offset#

#if defined(ENABLE_OVERLOADING)
    RoundedRectOffsetMethodInfo             ,
#endif
    roundedRectOffset                       ,


-- ** shrink #method:shrink#

#if defined(ENABLE_OVERLOADING)
    RoundedRectShrinkMethodInfo             ,
#endif
    roundedRectShrink                       ,




 -- * Properties


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

    getRoundedRectBounds                    ,
#if defined(ENABLE_OVERLOADING)
    roundedRect_bounds                      ,
#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.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 qualified GI.Graphene.Structs.Point as Graphene.Point
import qualified GI.Graphene.Structs.Rect as Graphene.Rect
import qualified GI.Graphene.Structs.Size as Graphene.Size

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

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

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


-- | Construct a `RoundedRect` struct initialized to zero.
newZeroRoundedRect :: MonadIO m => m RoundedRect
newZeroRoundedRect :: forall (m :: * -> *). MonadIO m => m RoundedRect
newZeroRoundedRect = IO RoundedRect -> m RoundedRect
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RoundedRect -> m RoundedRect)
-> IO RoundedRect -> m RoundedRect
forall a b. (a -> b) -> a -> b
$ IO (Ptr RoundedRect)
forall a. CallocPtr a => IO (Ptr a)
boxedPtrCalloc IO (Ptr RoundedRect)
-> (Ptr RoundedRect -> IO RoundedRect) -> IO RoundedRect
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr RoundedRect -> RoundedRect)
-> Ptr RoundedRect -> IO RoundedRect
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr RoundedRect -> RoundedRect
RoundedRect

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


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

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

roundedRect_bounds :: AttrLabelProxy "bounds"
roundedRect_bounds = AttrLabelProxy

#endif


-- XXX Skipped attribute for "RoundedRect:corner"
-- Not implemented: Don't know how to unpack C array of type TCArray False 4 (-1) (TInterface (Name {namespace = "Graphene", name = "Size"}))

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList RoundedRect
type instance O.AttributeList RoundedRect = RoundedRectAttributeList
type RoundedRectAttributeList = ('[ '("bounds", RoundedRectBoundsFieldInfo)] :: [(Symbol, *)])
#endif

-- method RoundedRect::contains_point
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "RoundedRect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskRoundedRect`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "point"
--           , argType =
--               TInterface Name { namespace = "Graphene" , 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 "gsk_rounded_rect_contains_point" gsk_rounded_rect_contains_point :: 
    Ptr RoundedRect ->                      -- self : TInterface (Name {namespace = "Gsk", name = "RoundedRect"})
    Ptr Graphene.Point.Point ->             -- point : TInterface (Name {namespace = "Graphene", name = "Point"})
    IO CInt

-- | Checks if the given /@point@/ is inside the rounded rectangle.
roundedRectContainsPoint ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RoundedRect
    -- ^ /@self@/: a @GskRoundedRect@
    -> Graphene.Point.Point
    -- ^ /@point@/: the point to check
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the /@point@/ is inside the rounded rectangle
roundedRectContainsPoint :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
RoundedRect -> Point -> m Bool
roundedRectContainsPoint RoundedRect
self 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 RoundedRect
self' <- RoundedRect -> IO (Ptr RoundedRect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RoundedRect
self
    Ptr Point
point' <- Point -> IO (Ptr Point)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point
point
    CInt
result <- Ptr RoundedRect -> Ptr Point -> IO CInt
gsk_rounded_rect_contains_point Ptr RoundedRect
self' Ptr Point
point'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    RoundedRect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RoundedRect
self
    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 RoundedRectContainsPointMethodInfo
instance (signature ~ (Graphene.Point.Point -> m Bool), MonadIO m) => O.OverloadedMethod RoundedRectContainsPointMethodInfo RoundedRect signature where
    overloadedMethod = roundedRectContainsPoint

instance O.OverloadedMethodInfo RoundedRectContainsPointMethodInfo RoundedRect where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Structs.RoundedRect.roundedRectContainsPoint",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.5/docs/GI-Gsk-Structs-RoundedRect.html#v:roundedRectContainsPoint"
        })


#endif

-- method RoundedRect::contains_rect
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "RoundedRect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskRoundedRect`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "rect"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the rectangle 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 "gsk_rounded_rect_contains_rect" gsk_rounded_rect_contains_rect :: 
    Ptr RoundedRect ->                      -- self : TInterface (Name {namespace = "Gsk", name = "RoundedRect"})
    Ptr Graphene.Rect.Rect ->               -- rect : TInterface (Name {namespace = "Graphene", name = "Rect"})
    IO CInt

-- | Checks if the given /@rect@/ is contained inside the rounded rectangle.
roundedRectContainsRect ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RoundedRect
    -- ^ /@self@/: a @GskRoundedRect@
    -> Graphene.Rect.Rect
    -- ^ /@rect@/: the rectangle to check
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the /@rect@/ is fully contained inside the rounded rectangle
roundedRectContainsRect :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
RoundedRect -> Rect -> m Bool
roundedRectContainsRect RoundedRect
self Rect
rect = 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 RoundedRect
self' <- RoundedRect -> IO (Ptr RoundedRect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RoundedRect
self
    Ptr Rect
rect' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
rect
    CInt
result <- Ptr RoundedRect -> Ptr Rect -> IO CInt
gsk_rounded_rect_contains_rect Ptr RoundedRect
self' Ptr Rect
rect'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    RoundedRect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RoundedRect
self
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
rect
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data RoundedRectContainsRectMethodInfo
instance (signature ~ (Graphene.Rect.Rect -> m Bool), MonadIO m) => O.OverloadedMethod RoundedRectContainsRectMethodInfo RoundedRect signature where
    overloadedMethod = roundedRectContainsRect

instance O.OverloadedMethodInfo RoundedRectContainsRectMethodInfo RoundedRect where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Structs.RoundedRect.roundedRectContainsRect",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.5/docs/GI-Gsk-Structs-RoundedRect.html#v:roundedRectContainsRect"
        })


#endif

-- method RoundedRect::init
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "RoundedRect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The `GskRoundedRect` to initialize"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bounds"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `graphene_rect_t` describing the bounds"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "top_left"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Size" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the rounding radius of the top left corner"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "top_right"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Size" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the rounding radius of the top right corner"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bottom_right"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Size" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the rounding radius of the bottom right corner"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bottom_left"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Size" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the rounding radius of the bottom left corner"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gsk" , name = "RoundedRect" })
-- throws : False
-- Skip return : False

foreign import ccall "gsk_rounded_rect_init" gsk_rounded_rect_init :: 
    Ptr RoundedRect ->                      -- self : TInterface (Name {namespace = "Gsk", name = "RoundedRect"})
    Ptr Graphene.Rect.Rect ->               -- bounds : TInterface (Name {namespace = "Graphene", name = "Rect"})
    Ptr Graphene.Size.Size ->               -- top_left : TInterface (Name {namespace = "Graphene", name = "Size"})
    Ptr Graphene.Size.Size ->               -- top_right : TInterface (Name {namespace = "Graphene", name = "Size"})
    Ptr Graphene.Size.Size ->               -- bottom_right : TInterface (Name {namespace = "Graphene", name = "Size"})
    Ptr Graphene.Size.Size ->               -- bottom_left : TInterface (Name {namespace = "Graphene", name = "Size"})
    IO (Ptr RoundedRect)

-- | Initializes the given @GskRoundedRect@ with the given values.
-- 
-- This function will implicitly normalize the @GskRoundedRect@
-- before returning.
roundedRectInit ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RoundedRect
    -- ^ /@self@/: The @GskRoundedRect@ to initialize
    -> Graphene.Rect.Rect
    -- ^ /@bounds@/: a @graphene_rect_t@ describing the bounds
    -> Graphene.Size.Size
    -- ^ /@topLeft@/: the rounding radius of the top left corner
    -> Graphene.Size.Size
    -- ^ /@topRight@/: the rounding radius of the top right corner
    -> Graphene.Size.Size
    -- ^ /@bottomRight@/: the rounding radius of the bottom right corner
    -> Graphene.Size.Size
    -- ^ /@bottomLeft@/: the rounding radius of the bottom left corner
    -> m RoundedRect
    -- ^ __Returns:__ the initialized rectangle
roundedRectInit :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
RoundedRect
-> Rect -> Size -> Size -> Size -> Size -> m RoundedRect
roundedRectInit RoundedRect
self Rect
bounds Size
topLeft Size
topRight Size
bottomRight Size
bottomLeft = IO RoundedRect -> m RoundedRect
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RoundedRect -> m RoundedRect)
-> IO RoundedRect -> m RoundedRect
forall a b. (a -> b) -> a -> b
$ do
    Ptr RoundedRect
self' <- RoundedRect -> IO (Ptr RoundedRect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RoundedRect
self
    Ptr Rect
bounds' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
bounds
    Ptr Size
topLeft' <- Size -> IO (Ptr Size)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Size
topLeft
    Ptr Size
topRight' <- Size -> IO (Ptr Size)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Size
topRight
    Ptr Size
bottomRight' <- Size -> IO (Ptr Size)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Size
bottomRight
    Ptr Size
bottomLeft' <- Size -> IO (Ptr Size)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Size
bottomLeft
    Ptr RoundedRect
result <- Ptr RoundedRect
-> Ptr Rect
-> Ptr Size
-> Ptr Size
-> Ptr Size
-> Ptr Size
-> IO (Ptr RoundedRect)
gsk_rounded_rect_init Ptr RoundedRect
self' Ptr Rect
bounds' Ptr Size
topLeft' Ptr Size
topRight' Ptr Size
bottomRight' Ptr Size
bottomLeft'
    Text -> Ptr RoundedRect -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"roundedRectInit" Ptr RoundedRect
result
    RoundedRect
result' <- ((ManagedPtr RoundedRect -> RoundedRect)
-> Ptr RoundedRect -> IO RoundedRect
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr RoundedRect -> RoundedRect
RoundedRect) Ptr RoundedRect
result
    RoundedRect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RoundedRect
self
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
bounds
    Size -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Size
topLeft
    Size -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Size
topRight
    Size -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Size
bottomRight
    Size -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Size
bottomLeft
    RoundedRect -> IO RoundedRect
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RoundedRect
result'

#if defined(ENABLE_OVERLOADING)
data RoundedRectInitMethodInfo
instance (signature ~ (Graphene.Rect.Rect -> Graphene.Size.Size -> Graphene.Size.Size -> Graphene.Size.Size -> Graphene.Size.Size -> m RoundedRect), MonadIO m) => O.OverloadedMethod RoundedRectInitMethodInfo RoundedRect signature where
    overloadedMethod = roundedRectInit

instance O.OverloadedMethodInfo RoundedRectInitMethodInfo RoundedRect where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Structs.RoundedRect.roundedRectInit",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.5/docs/GI-Gsk-Structs-RoundedRect.html#v:roundedRectInit"
        })


#endif

-- method RoundedRect::init_copy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "RoundedRect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskRoundedRect`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "src"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "RoundedRect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskRoundedRect`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gsk" , name = "RoundedRect" })
-- throws : False
-- Skip return : False

foreign import ccall "gsk_rounded_rect_init_copy" gsk_rounded_rect_init_copy :: 
    Ptr RoundedRect ->                      -- self : TInterface (Name {namespace = "Gsk", name = "RoundedRect"})
    Ptr RoundedRect ->                      -- src : TInterface (Name {namespace = "Gsk", name = "RoundedRect"})
    IO (Ptr RoundedRect)

-- | Initializes /@self@/ using the given /@src@/ rectangle.
-- 
-- This function will not normalize the @GskRoundedRect@,
-- so make sure the source is normalized.
roundedRectInitCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RoundedRect
    -- ^ /@self@/: a @GskRoundedRect@
    -> RoundedRect
    -- ^ /@src@/: a @GskRoundedRect@
    -> m RoundedRect
    -- ^ __Returns:__ the initialized rectangle
roundedRectInitCopy :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
RoundedRect -> RoundedRect -> m RoundedRect
roundedRectInitCopy RoundedRect
self RoundedRect
src = IO RoundedRect -> m RoundedRect
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RoundedRect -> m RoundedRect)
-> IO RoundedRect -> m RoundedRect
forall a b. (a -> b) -> a -> b
$ do
    Ptr RoundedRect
self' <- RoundedRect -> IO (Ptr RoundedRect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RoundedRect
self
    Ptr RoundedRect
src' <- RoundedRect -> IO (Ptr RoundedRect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RoundedRect
src
    Ptr RoundedRect
result <- Ptr RoundedRect -> Ptr RoundedRect -> IO (Ptr RoundedRect)
gsk_rounded_rect_init_copy Ptr RoundedRect
self' Ptr RoundedRect
src'
    Text -> Ptr RoundedRect -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"roundedRectInitCopy" Ptr RoundedRect
result
    RoundedRect
result' <- ((ManagedPtr RoundedRect -> RoundedRect)
-> Ptr RoundedRect -> IO RoundedRect
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr RoundedRect -> RoundedRect
RoundedRect) Ptr RoundedRect
result
    RoundedRect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RoundedRect
self
    RoundedRect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RoundedRect
src
    RoundedRect -> IO RoundedRect
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RoundedRect
result'

#if defined(ENABLE_OVERLOADING)
data RoundedRectInitCopyMethodInfo
instance (signature ~ (RoundedRect -> m RoundedRect), MonadIO m) => O.OverloadedMethod RoundedRectInitCopyMethodInfo RoundedRect signature where
    overloadedMethod = roundedRectInitCopy

instance O.OverloadedMethodInfo RoundedRectInitCopyMethodInfo RoundedRect where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Structs.RoundedRect.roundedRectInitCopy",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.5/docs/GI-Gsk-Structs-RoundedRect.html#v:roundedRectInitCopy"
        })


#endif

-- method RoundedRect::init_from_rect
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "RoundedRect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskRoundedRect`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bounds"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `graphene_rect_t`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "radius"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the border radius" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gsk" , name = "RoundedRect" })
-- throws : False
-- Skip return : False

foreign import ccall "gsk_rounded_rect_init_from_rect" gsk_rounded_rect_init_from_rect :: 
    Ptr RoundedRect ->                      -- self : TInterface (Name {namespace = "Gsk", name = "RoundedRect"})
    Ptr Graphene.Rect.Rect ->               -- bounds : TInterface (Name {namespace = "Graphene", name = "Rect"})
    CFloat ->                               -- radius : TBasicType TFloat
    IO (Ptr RoundedRect)

-- | Initializes /@self@/ to the given /@bounds@/ and sets the radius
-- of all four corners to /@radius@/.
roundedRectInitFromRect ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RoundedRect
    -- ^ /@self@/: a @GskRoundedRect@
    -> Graphene.Rect.Rect
    -- ^ /@bounds@/: a @graphene_rect_t@
    -> Float
    -- ^ /@radius@/: the border radius
    -> m RoundedRect
    -- ^ __Returns:__ the initialized rectangle
roundedRectInitFromRect :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
RoundedRect -> Rect -> Float -> m RoundedRect
roundedRectInitFromRect RoundedRect
self Rect
bounds Float
radius = IO RoundedRect -> m RoundedRect
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RoundedRect -> m RoundedRect)
-> IO RoundedRect -> m RoundedRect
forall a b. (a -> b) -> a -> b
$ do
    Ptr RoundedRect
self' <- RoundedRect -> IO (Ptr RoundedRect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RoundedRect
self
    Ptr Rect
bounds' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
bounds
    let radius' :: CFloat
radius' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius
    Ptr RoundedRect
result <- Ptr RoundedRect -> Ptr Rect -> CFloat -> IO (Ptr RoundedRect)
gsk_rounded_rect_init_from_rect Ptr RoundedRect
self' Ptr Rect
bounds' CFloat
radius'
    Text -> Ptr RoundedRect -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"roundedRectInitFromRect" Ptr RoundedRect
result
    RoundedRect
result' <- ((ManagedPtr RoundedRect -> RoundedRect)
-> Ptr RoundedRect -> IO RoundedRect
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr RoundedRect -> RoundedRect
RoundedRect) Ptr RoundedRect
result
    RoundedRect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RoundedRect
self
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
bounds
    RoundedRect -> IO RoundedRect
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RoundedRect
result'

#if defined(ENABLE_OVERLOADING)
data RoundedRectInitFromRectMethodInfo
instance (signature ~ (Graphene.Rect.Rect -> Float -> m RoundedRect), MonadIO m) => O.OverloadedMethod RoundedRectInitFromRectMethodInfo RoundedRect signature where
    overloadedMethod = roundedRectInitFromRect

instance O.OverloadedMethodInfo RoundedRectInitFromRectMethodInfo RoundedRect where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Structs.RoundedRect.roundedRectInitFromRect",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.5/docs/GI-Gsk-Structs-RoundedRect.html#v:roundedRectInitFromRect"
        })


#endif

-- method RoundedRect::intersects_rect
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "RoundedRect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskRoundedRect`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "rect"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the rectangle 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 "gsk_rounded_rect_intersects_rect" gsk_rounded_rect_intersects_rect :: 
    Ptr RoundedRect ->                      -- self : TInterface (Name {namespace = "Gsk", name = "RoundedRect"})
    Ptr Graphene.Rect.Rect ->               -- rect : TInterface (Name {namespace = "Graphene", name = "Rect"})
    IO CInt

-- | Checks if part of the given /@rect@/ is contained inside the rounded rectangle.
roundedRectIntersectsRect ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RoundedRect
    -- ^ /@self@/: a @GskRoundedRect@
    -> Graphene.Rect.Rect
    -- ^ /@rect@/: the rectangle to check
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the /@rect@/ intersects with the rounded rectangle
roundedRectIntersectsRect :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
RoundedRect -> Rect -> m Bool
roundedRectIntersectsRect RoundedRect
self Rect
rect = 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 RoundedRect
self' <- RoundedRect -> IO (Ptr RoundedRect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RoundedRect
self
    Ptr Rect
rect' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
rect
    CInt
result <- Ptr RoundedRect -> Ptr Rect -> IO CInt
gsk_rounded_rect_intersects_rect Ptr RoundedRect
self' Ptr Rect
rect'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    RoundedRect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RoundedRect
self
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
rect
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data RoundedRectIntersectsRectMethodInfo
instance (signature ~ (Graphene.Rect.Rect -> m Bool), MonadIO m) => O.OverloadedMethod RoundedRectIntersectsRectMethodInfo RoundedRect signature where
    overloadedMethod = roundedRectIntersectsRect

instance O.OverloadedMethodInfo RoundedRectIntersectsRectMethodInfo RoundedRect where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Structs.RoundedRect.roundedRectIntersectsRect",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.5/docs/GI-Gsk-Structs-RoundedRect.html#v:roundedRectIntersectsRect"
        })


#endif

-- method RoundedRect::is_rectilinear
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "RoundedRect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the `GskRoundedRect` 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 "gsk_rounded_rect_is_rectilinear" gsk_rounded_rect_is_rectilinear :: 
    Ptr RoundedRect ->                      -- self : TInterface (Name {namespace = "Gsk", name = "RoundedRect"})
    IO CInt

-- | Checks if all corners of /@self@/ are right angles and the
-- rectangle covers all of its bounds.
-- 
-- This information can be used to decide if 'GI.Gsk.Objects.ClipNode.clipNodeNew'
-- or 'GI.Gsk.Objects.RoundedClipNode.roundedClipNodeNew' should be called.
roundedRectIsRectilinear ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RoundedRect
    -- ^ /@self@/: the @GskRoundedRect@ to check
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the rectangle is rectilinear
roundedRectIsRectilinear :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
RoundedRect -> m Bool
roundedRectIsRectilinear RoundedRect
self = 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 RoundedRect
self' <- RoundedRect -> IO (Ptr RoundedRect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RoundedRect
self
    CInt
result <- Ptr RoundedRect -> IO CInt
gsk_rounded_rect_is_rectilinear Ptr RoundedRect
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    RoundedRect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RoundedRect
self
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data RoundedRectIsRectilinearMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod RoundedRectIsRectilinearMethodInfo RoundedRect signature where
    overloadedMethod = roundedRectIsRectilinear

instance O.OverloadedMethodInfo RoundedRectIsRectilinearMethodInfo RoundedRect where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Structs.RoundedRect.roundedRectIsRectilinear",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.5/docs/GI-Gsk-Structs-RoundedRect.html#v:roundedRectIsRectilinear"
        })


#endif

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

foreign import ccall "gsk_rounded_rect_normalize" gsk_rounded_rect_normalize :: 
    Ptr RoundedRect ->                      -- self : TInterface (Name {namespace = "Gsk", name = "RoundedRect"})
    IO (Ptr RoundedRect)

-- | Normalizes the passed rectangle.
-- 
-- This function will ensure that the bounds of the rectangle
-- are normalized and ensure that the corner values are positive
-- and the corners do not overlap.
roundedRectNormalize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RoundedRect
    -- ^ /@self@/: a @GskRoundedRect@
    -> m RoundedRect
    -- ^ __Returns:__ the normalized rectangle
roundedRectNormalize :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
RoundedRect -> m RoundedRect
roundedRectNormalize RoundedRect
self = IO RoundedRect -> m RoundedRect
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RoundedRect -> m RoundedRect)
-> IO RoundedRect -> m RoundedRect
forall a b. (a -> b) -> a -> b
$ do
    Ptr RoundedRect
self' <- RoundedRect -> IO (Ptr RoundedRect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RoundedRect
self
    Ptr RoundedRect
result <- Ptr RoundedRect -> IO (Ptr RoundedRect)
gsk_rounded_rect_normalize Ptr RoundedRect
self'
    Text -> Ptr RoundedRect -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"roundedRectNormalize" Ptr RoundedRect
result
    RoundedRect
result' <- ((ManagedPtr RoundedRect -> RoundedRect)
-> Ptr RoundedRect -> IO RoundedRect
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr RoundedRect -> RoundedRect
RoundedRect) Ptr RoundedRect
result
    RoundedRect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RoundedRect
self
    RoundedRect -> IO RoundedRect
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RoundedRect
result'

#if defined(ENABLE_OVERLOADING)
data RoundedRectNormalizeMethodInfo
instance (signature ~ (m RoundedRect), MonadIO m) => O.OverloadedMethod RoundedRectNormalizeMethodInfo RoundedRect signature where
    overloadedMethod = roundedRectNormalize

instance O.OverloadedMethodInfo RoundedRectNormalizeMethodInfo RoundedRect where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Structs.RoundedRect.roundedRectNormalize",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.5/docs/GI-Gsk-Structs-RoundedRect.html#v:roundedRectNormalize"
        })


#endif

-- method RoundedRect::offset
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "RoundedRect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskRoundedRect`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dx"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the horizontal offset"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dy"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the vertical offset"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gsk" , name = "RoundedRect" })
-- throws : False
-- Skip return : False

foreign import ccall "gsk_rounded_rect_offset" gsk_rounded_rect_offset :: 
    Ptr RoundedRect ->                      -- self : TInterface (Name {namespace = "Gsk", name = "RoundedRect"})
    CFloat ->                               -- dx : TBasicType TFloat
    CFloat ->                               -- dy : TBasicType TFloat
    IO (Ptr RoundedRect)

-- | Offsets the bound\'s origin by /@dx@/ and /@dy@/.
-- 
-- The size and corners of the rectangle are unchanged.
roundedRectOffset ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RoundedRect
    -- ^ /@self@/: a @GskRoundedRect@
    -> Float
    -- ^ /@dx@/: the horizontal offset
    -> Float
    -- ^ /@dy@/: the vertical offset
    -> m RoundedRect
    -- ^ __Returns:__ the offset rectangle
roundedRectOffset :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
RoundedRect -> Float -> Float -> m RoundedRect
roundedRectOffset RoundedRect
self Float
dx Float
dy = IO RoundedRect -> m RoundedRect
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RoundedRect -> m RoundedRect)
-> IO RoundedRect -> m RoundedRect
forall a b. (a -> b) -> a -> b
$ do
    Ptr RoundedRect
self' <- RoundedRect -> IO (Ptr RoundedRect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RoundedRect
self
    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 RoundedRect
result <- Ptr RoundedRect -> CFloat -> CFloat -> IO (Ptr RoundedRect)
gsk_rounded_rect_offset Ptr RoundedRect
self' CFloat
dx' CFloat
dy'
    Text -> Ptr RoundedRect -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"roundedRectOffset" Ptr RoundedRect
result
    RoundedRect
result' <- ((ManagedPtr RoundedRect -> RoundedRect)
-> Ptr RoundedRect -> IO RoundedRect
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr RoundedRect -> RoundedRect
RoundedRect) Ptr RoundedRect
result
    RoundedRect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RoundedRect
self
    RoundedRect -> IO RoundedRect
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RoundedRect
result'

#if defined(ENABLE_OVERLOADING)
data RoundedRectOffsetMethodInfo
instance (signature ~ (Float -> Float -> m RoundedRect), MonadIO m) => O.OverloadedMethod RoundedRectOffsetMethodInfo RoundedRect signature where
    overloadedMethod = roundedRectOffset

instance O.OverloadedMethodInfo RoundedRectOffsetMethodInfo RoundedRect where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Structs.RoundedRect.roundedRectOffset",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.5/docs/GI-Gsk-Structs-RoundedRect.html#v:roundedRectOffset"
        })


#endif

-- method RoundedRect::shrink
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "RoundedRect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The `GskRoundedRect` to shrink or grow"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "top"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "How far to move the top side downwards"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "right"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "How far to move the right side to the left"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bottom"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "How far to move the bottom side upwards"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "left"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "How far to move the left side to the right"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gsk" , name = "RoundedRect" })
-- throws : False
-- Skip return : False

foreign import ccall "gsk_rounded_rect_shrink" gsk_rounded_rect_shrink :: 
    Ptr RoundedRect ->                      -- self : TInterface (Name {namespace = "Gsk", name = "RoundedRect"})
    CFloat ->                               -- top : TBasicType TFloat
    CFloat ->                               -- right : TBasicType TFloat
    CFloat ->                               -- bottom : TBasicType TFloat
    CFloat ->                               -- left : TBasicType TFloat
    IO (Ptr RoundedRect)

-- | Shrinks (or grows) the given rectangle by moving the 4 sides
-- according to the offsets given.
-- 
-- The corner radii will be changed in a way that tries to keep
-- the center of the corner circle intact. This emulates CSS behavior.
-- 
-- This function also works for growing rectangles if you pass
-- negative values for the /@top@/, /@right@/, /@bottom@/ or /@left@/.
roundedRectShrink ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RoundedRect
    -- ^ /@self@/: The @GskRoundedRect@ to shrink or grow
    -> Float
    -- ^ /@top@/: How far to move the top side downwards
    -> Float
    -- ^ /@right@/: How far to move the right side to the left
    -> Float
    -- ^ /@bottom@/: How far to move the bottom side upwards
    -> Float
    -- ^ /@left@/: How far to move the left side to the right
    -> m RoundedRect
    -- ^ __Returns:__ the resized @GskRoundedRect@
roundedRectShrink :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
RoundedRect -> Float -> Float -> Float -> Float -> m RoundedRect
roundedRectShrink RoundedRect
self Float
top Float
right Float
bottom Float
left = IO RoundedRect -> m RoundedRect
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RoundedRect -> m RoundedRect)
-> IO RoundedRect -> m RoundedRect
forall a b. (a -> b) -> a -> b
$ do
    Ptr RoundedRect
self' <- RoundedRect -> IO (Ptr RoundedRect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RoundedRect
self
    let top' :: CFloat
top' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
top
    let right' :: CFloat
right' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
right
    let bottom' :: CFloat
bottom' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
bottom
    let left' :: CFloat
left' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
left
    Ptr RoundedRect
result <- Ptr RoundedRect
-> CFloat -> CFloat -> CFloat -> CFloat -> IO (Ptr RoundedRect)
gsk_rounded_rect_shrink Ptr RoundedRect
self' CFloat
top' CFloat
right' CFloat
bottom' CFloat
left'
    Text -> Ptr RoundedRect -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"roundedRectShrink" Ptr RoundedRect
result
    RoundedRect
result' <- ((ManagedPtr RoundedRect -> RoundedRect)
-> Ptr RoundedRect -> IO RoundedRect
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr RoundedRect -> RoundedRect
RoundedRect) Ptr RoundedRect
result
    RoundedRect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RoundedRect
self
    RoundedRect -> IO RoundedRect
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RoundedRect
result'

#if defined(ENABLE_OVERLOADING)
data RoundedRectShrinkMethodInfo
instance (signature ~ (Float -> Float -> Float -> Float -> m RoundedRect), MonadIO m) => O.OverloadedMethod RoundedRectShrinkMethodInfo RoundedRect signature where
    overloadedMethod = roundedRectShrink

instance O.OverloadedMethodInfo RoundedRectShrinkMethodInfo RoundedRect where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Structs.RoundedRect.roundedRectShrink",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.5/docs/GI-Gsk-Structs-RoundedRect.html#v:roundedRectShrink"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveRoundedRectMethod (t :: Symbol) (o :: *) :: * where
    ResolveRoundedRectMethod "containsPoint" o = RoundedRectContainsPointMethodInfo
    ResolveRoundedRectMethod "containsRect" o = RoundedRectContainsRectMethodInfo
    ResolveRoundedRectMethod "init" o = RoundedRectInitMethodInfo
    ResolveRoundedRectMethod "initCopy" o = RoundedRectInitCopyMethodInfo
    ResolveRoundedRectMethod "initFromRect" o = RoundedRectInitFromRectMethodInfo
    ResolveRoundedRectMethod "intersectsRect" o = RoundedRectIntersectsRectMethodInfo
    ResolveRoundedRectMethod "isRectilinear" o = RoundedRectIsRectilinearMethodInfo
    ResolveRoundedRectMethod "normalize" o = RoundedRectNormalizeMethodInfo
    ResolveRoundedRectMethod "offset" o = RoundedRectOffsetMethodInfo
    ResolveRoundedRectMethod "shrink" o = RoundedRectShrinkMethodInfo
    ResolveRoundedRectMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif