{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A @GdkRGBA@ is used to represent a color, in a way that is compatible
-- with cairo’s notion of color.
-- 
-- @GdkRGBA@ is a convenient way to pass colors around. It’s based on
-- cairo’s way to deal with colors and mirrors its behavior. All values
-- are in the range from 0.0 to 1.0 inclusive. So the color
-- (0.0, 0.0, 0.0, 0.0) represents transparent black and
-- (1.0, 1.0, 1.0, 1.0) is opaque white. Other values will
-- be clamped to this range when drawing.

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

module GI.Gdk.Structs.RGBA
    ( 

-- * Exported types
    RGBA(..)                                ,
    newZeroRGBA                             ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [copy]("GI.Gdk.Structs.RGBA#g:method:copy"), [equal]("GI.Gdk.Structs.RGBA#g:method:equal"), [free]("GI.Gdk.Structs.RGBA#g:method:free"), [hash]("GI.Gdk.Structs.RGBA#g:method:hash"), [isClear]("GI.Gdk.Structs.RGBA#g:method:isClear"), [isOpaque]("GI.Gdk.Structs.RGBA#g:method:isOpaque"), [parse]("GI.Gdk.Structs.RGBA#g:method:parse"), [toString]("GI.Gdk.Structs.RGBA#g:method:toString").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveRGBAMethod                       ,
#endif

-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    RGBACopyMethodInfo                      ,
#endif
    rGBACopy                                ,


-- ** equal #method:equal#

#if defined(ENABLE_OVERLOADING)
    RGBAEqualMethodInfo                     ,
#endif
    rGBAEqual                               ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    RGBAFreeMethodInfo                      ,
#endif
    rGBAFree                                ,


-- ** hash #method:hash#

#if defined(ENABLE_OVERLOADING)
    RGBAHashMethodInfo                      ,
#endif
    rGBAHash                                ,


-- ** isClear #method:isClear#

#if defined(ENABLE_OVERLOADING)
    RGBAIsClearMethodInfo                   ,
#endif
    rGBAIsClear                             ,


-- ** isOpaque #method:isOpaque#

#if defined(ENABLE_OVERLOADING)
    RGBAIsOpaqueMethodInfo                  ,
#endif
    rGBAIsOpaque                            ,


-- ** parse #method:parse#

#if defined(ENABLE_OVERLOADING)
    RGBAParseMethodInfo                     ,
#endif
    rGBAParse                               ,


-- ** toString #method:toString#

#if defined(ENABLE_OVERLOADING)
    RGBAToStringMethodInfo                  ,
#endif
    rGBAToString                            ,




 -- * Properties


-- ** alpha #attr:alpha#
-- | The opacity of the color from 0.0 for completely translucent to
--   1.0 for opaque

    getRGBAAlpha                            ,
#if defined(ENABLE_OVERLOADING)
    rGBA_alpha                              ,
#endif
    setRGBAAlpha                            ,


-- ** blue #attr:blue#
-- | The intensity of the blue channel from 0.0 to 1.0 inclusive

    getRGBABlue                             ,
#if defined(ENABLE_OVERLOADING)
    rGBA_blue                               ,
#endif
    setRGBABlue                             ,


-- ** green #attr:green#
-- | The intensity of the green channel from 0.0 to 1.0 inclusive

    getRGBAGreen                            ,
#if defined(ENABLE_OVERLOADING)
    rGBA_green                              ,
#endif
    setRGBAGreen                            ,


-- ** red #attr:red#
-- | The intensity of the red channel from 0.0 to 1.0 inclusive

    getRGBARed                              ,
#if defined(ENABLE_OVERLOADING)
    rGBA_red                                ,
#endif
    setRGBARed                              ,




    ) where

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

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

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)

#else

#endif

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

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

foreign import ccall "gdk_rgba_get_type" c_gdk_rgba_get_type :: 
    IO GType

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

instance B.Types.TypedObject RGBA where
    glibType :: IO GType
glibType = IO GType
c_gdk_rgba_get_type

instance B.Types.GBoxed RGBA

-- | Convert 'RGBA' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe RGBA) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gdk_rgba_get_type
    gvalueSet_ :: Ptr GValue -> Maybe RGBA -> IO ()
gvalueSet_ Ptr GValue
gv Maybe RGBA
P.Nothing = Ptr GValue -> Ptr RGBA -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr RGBA
forall a. Ptr a
FP.nullPtr :: FP.Ptr RGBA)
    gvalueSet_ Ptr GValue
gv (P.Just RGBA
obj) = RGBA -> (Ptr RGBA -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr RGBA
obj (Ptr GValue -> Ptr RGBA -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe RGBA)
gvalueGet_ Ptr GValue
gv = do
        ptr <- Ptr GValue -> IO (Ptr RGBA)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr RGBA)
        if ptr /= FP.nullPtr
        then P.Just <$> B.ManagedPtr.newBoxed RGBA ptr
        else return P.Nothing
        
    

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

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


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

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

#if defined(ENABLE_OVERLOADING)
data RGBARedFieldInfo
instance AttrInfo RGBARedFieldInfo where
    type AttrBaseTypeConstraint RGBARedFieldInfo = (~) RGBA
    type AttrAllowedOps RGBARedFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint RGBARedFieldInfo = (~) Float
    type AttrTransferTypeConstraint RGBARedFieldInfo = (~)Float
    type AttrTransferType RGBARedFieldInfo = Float
    type AttrGetType RGBARedFieldInfo = Float
    type AttrLabel RGBARedFieldInfo = "red"
    type AttrOrigin RGBARedFieldInfo = RGBA
    attrGet = getRGBARed
    attrSet = setRGBARed
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.RGBA.red"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-RGBA.html#g:attr:red"
        })

rGBA_red :: AttrLabelProxy "red"
rGBA_red = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data RGBAGreenFieldInfo
instance AttrInfo RGBAGreenFieldInfo where
    type AttrBaseTypeConstraint RGBAGreenFieldInfo = (~) RGBA
    type AttrAllowedOps RGBAGreenFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint RGBAGreenFieldInfo = (~) Float
    type AttrTransferTypeConstraint RGBAGreenFieldInfo = (~)Float
    type AttrTransferType RGBAGreenFieldInfo = Float
    type AttrGetType RGBAGreenFieldInfo = Float
    type AttrLabel RGBAGreenFieldInfo = "green"
    type AttrOrigin RGBAGreenFieldInfo = RGBA
    attrGet = getRGBAGreen
    attrSet = setRGBAGreen
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.RGBA.green"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-RGBA.html#g:attr:green"
        })

rGBA_green :: AttrLabelProxy "green"
rGBA_green = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data RGBABlueFieldInfo
instance AttrInfo RGBABlueFieldInfo where
    type AttrBaseTypeConstraint RGBABlueFieldInfo = (~) RGBA
    type AttrAllowedOps RGBABlueFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint RGBABlueFieldInfo = (~) Float
    type AttrTransferTypeConstraint RGBABlueFieldInfo = (~)Float
    type AttrTransferType RGBABlueFieldInfo = Float
    type AttrGetType RGBABlueFieldInfo = Float
    type AttrLabel RGBABlueFieldInfo = "blue"
    type AttrOrigin RGBABlueFieldInfo = RGBA
    attrGet = getRGBABlue
    attrSet = setRGBABlue
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.RGBA.blue"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-RGBA.html#g:attr:blue"
        })

rGBA_blue :: AttrLabelProxy "blue"
rGBA_blue = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data RGBAAlphaFieldInfo
instance AttrInfo RGBAAlphaFieldInfo where
    type AttrBaseTypeConstraint RGBAAlphaFieldInfo = (~) RGBA
    type AttrAllowedOps RGBAAlphaFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint RGBAAlphaFieldInfo = (~) Float
    type AttrTransferTypeConstraint RGBAAlphaFieldInfo = (~)Float
    type AttrTransferType RGBAAlphaFieldInfo = Float
    type AttrGetType RGBAAlphaFieldInfo = Float
    type AttrLabel RGBAAlphaFieldInfo = "alpha"
    type AttrOrigin RGBAAlphaFieldInfo = RGBA
    attrGet = getRGBAAlpha
    attrSet = setRGBAAlpha
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.RGBA.alpha"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-RGBA.html#g:attr:alpha"
        })

rGBA_alpha :: AttrLabelProxy "alpha"
rGBA_alpha = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList RGBA
type instance O.AttributeList RGBA = RGBAAttributeList
type RGBAAttributeList = ('[ '("red", RGBARedFieldInfo), '("green", RGBAGreenFieldInfo), '("blue", RGBABlueFieldInfo), '("alpha", RGBAAlphaFieldInfo)] :: [(Symbol, DK.Type)])
#endif

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

foreign import ccall "gdk_rgba_copy" gdk_rgba_copy :: 
    Ptr RGBA ->                             -- rgba : TInterface (Name {namespace = "Gdk", name = "RGBA"})
    IO (Ptr RGBA)

-- | Makes a copy of a @GdkRGBA@.
-- 
-- The result must be freed through 'GI.Gdk.Structs.RGBA.rGBAFree'.
rGBACopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RGBA
    -- ^ /@rgba@/: a @GdkRGBA@
    -> m RGBA
    -- ^ __Returns:__ A newly allocated @GdkRGBA@, with the same contents as /@rgba@/
rGBACopy :: forall (m :: * -> *). (HasCallStack, MonadIO m) => RGBA -> m RGBA
rGBACopy RGBA
rgba = IO RGBA -> m RGBA
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RGBA -> m RGBA) -> IO RGBA -> m RGBA
forall a b. (a -> b) -> a -> b
$ do
    rgba' <- RGBA -> IO (Ptr RGBA)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RGBA
rgba
    result <- gdk_rgba_copy rgba'
    checkUnexpectedReturnNULL "rGBACopy" result
    result' <- (wrapBoxed RGBA) result
    touchManagedPtr rgba
    return result'

#if defined(ENABLE_OVERLOADING)
data RGBACopyMethodInfo
instance (signature ~ (m RGBA), MonadIO m) => O.OverloadedMethod RGBACopyMethodInfo RGBA signature where
    overloadedMethod = rGBACopy

instance O.OverloadedMethodInfo RGBACopyMethodInfo RGBA where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.RGBA.rGBACopy",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-RGBA.html#v:rGBACopy"
        })


#endif

-- method RGBA::equal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "p1"
--           , argType = TInterface Name { namespace = "Gdk" , name = "RGBA" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkRGBA`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "p2"
--           , argType = TInterface Name { namespace = "Gdk" , name = "RGBA" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "another `GdkRGBA`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_rgba_equal" gdk_rgba_equal :: 
    Ptr RGBA ->                             -- p1 : TInterface (Name {namespace = "Gdk", name = "RGBA"})
    Ptr RGBA ->                             -- p2 : TInterface (Name {namespace = "Gdk", name = "RGBA"})
    IO CInt

-- | Compares two @GdkRGBA@ colors.
rGBAEqual ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RGBA
    -- ^ /@p1@/: a @GdkRGBA@
    -> RGBA
    -- ^ /@p2@/: another @GdkRGBA@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the two colors compare equal
rGBAEqual :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
RGBA -> RGBA -> m Bool
rGBAEqual RGBA
p1 RGBA
p2 = 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
    p1' <- RGBA -> IO (Ptr RGBA)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RGBA
p1
    p2' <- unsafeManagedPtrGetPtr p2
    result <- gdk_rgba_equal p1' p2'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr p1
    touchManagedPtr p2
    return result'

#if defined(ENABLE_OVERLOADING)
data RGBAEqualMethodInfo
instance (signature ~ (RGBA -> m Bool), MonadIO m) => O.OverloadedMethod RGBAEqualMethodInfo RGBA signature where
    overloadedMethod = rGBAEqual

instance O.OverloadedMethodInfo RGBAEqualMethodInfo RGBA where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.RGBA.rGBAEqual",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-RGBA.html#v:rGBAEqual"
        })


#endif

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

foreign import ccall "gdk_rgba_free" gdk_rgba_free :: 
    Ptr RGBA ->                             -- rgba : TInterface (Name {namespace = "Gdk", name = "RGBA"})
    IO ()

-- | Frees a @GdkRGBA@.
rGBAFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RGBA
    -- ^ /@rgba@/: a @GdkRGBA@
    -> m ()
rGBAFree :: forall (m :: * -> *). (HasCallStack, MonadIO m) => RGBA -> m ()
rGBAFree RGBA
rgba = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    rgba' <- RGBA -> IO (Ptr RGBA)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RGBA
rgba
    gdk_rgba_free rgba'
    touchManagedPtr rgba
    return ()

#if defined(ENABLE_OVERLOADING)
data RGBAFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod RGBAFreeMethodInfo RGBA signature where
    overloadedMethod = rGBAFree

instance O.OverloadedMethodInfo RGBAFreeMethodInfo RGBA where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.RGBA.rGBAFree",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-RGBA.html#v:rGBAFree"
        })


#endif

-- method RGBA::hash
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "p"
--           , argType = TInterface Name { namespace = "Gdk" , name = "RGBA" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkRGBA`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_rgba_hash" gdk_rgba_hash :: 
    Ptr RGBA ->                             -- p : TInterface (Name {namespace = "Gdk", name = "RGBA"})
    IO Word32

-- | A hash function suitable for using for a hash
-- table that stores @GdkRGBA@s.
rGBAHash ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RGBA
    -- ^ /@p@/: a @GdkRGBA@
    -> m Word32
    -- ^ __Returns:__ The hash value for /@p@/
rGBAHash :: forall (m :: * -> *). (HasCallStack, MonadIO m) => RGBA -> m Word32
rGBAHash RGBA
p = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    p' <- RGBA -> IO (Ptr RGBA)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RGBA
p
    result <- gdk_rgba_hash p'
    touchManagedPtr p
    return result

#if defined(ENABLE_OVERLOADING)
data RGBAHashMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.OverloadedMethod RGBAHashMethodInfo RGBA signature where
    overloadedMethod = rGBAHash

instance O.OverloadedMethodInfo RGBAHashMethodInfo RGBA where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.RGBA.rGBAHash",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-RGBA.html#v:rGBAHash"
        })


#endif

-- method RGBA::is_clear
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "rgba"
--           , argType = TInterface Name { namespace = "Gdk" , name = "RGBA" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkRGBA`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_rgba_is_clear" gdk_rgba_is_clear :: 
    Ptr RGBA ->                             -- rgba : TInterface (Name {namespace = "Gdk", name = "RGBA"})
    IO CInt

-- | Checks if an /@rgba@/ value is transparent.
-- 
-- That is, drawing with the value would not produce any change.
rGBAIsClear ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RGBA
    -- ^ /@rgba@/: a @GdkRGBA@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the /@rgba@/ is clear
rGBAIsClear :: forall (m :: * -> *). (HasCallStack, MonadIO m) => RGBA -> m Bool
rGBAIsClear RGBA
rgba = 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
    rgba' <- RGBA -> IO (Ptr RGBA)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RGBA
rgba
    result <- gdk_rgba_is_clear rgba'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr rgba
    return result'

#if defined(ENABLE_OVERLOADING)
data RGBAIsClearMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod RGBAIsClearMethodInfo RGBA signature where
    overloadedMethod = rGBAIsClear

instance O.OverloadedMethodInfo RGBAIsClearMethodInfo RGBA where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.RGBA.rGBAIsClear",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-RGBA.html#v:rGBAIsClear"
        })


#endif

-- method RGBA::is_opaque
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "rgba"
--           , argType = TInterface Name { namespace = "Gdk" , name = "RGBA" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkRGBA`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_rgba_is_opaque" gdk_rgba_is_opaque :: 
    Ptr RGBA ->                             -- rgba : TInterface (Name {namespace = "Gdk", name = "RGBA"})
    IO CInt

-- | Checks if an /@rgba@/ value is opaque.
-- 
-- That is, drawing with the value will not retain any results
-- from previous contents.
rGBAIsOpaque ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RGBA
    -- ^ /@rgba@/: a @GdkRGBA@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the /@rgba@/ is opaque
rGBAIsOpaque :: forall (m :: * -> *). (HasCallStack, MonadIO m) => RGBA -> m Bool
rGBAIsOpaque RGBA
rgba = 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
    rgba' <- RGBA -> IO (Ptr RGBA)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RGBA
rgba
    result <- gdk_rgba_is_opaque rgba'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr rgba
    return result'

#if defined(ENABLE_OVERLOADING)
data RGBAIsOpaqueMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod RGBAIsOpaqueMethodInfo RGBA signature where
    overloadedMethod = rGBAIsOpaque

instance O.OverloadedMethodInfo RGBAIsOpaqueMethodInfo RGBA where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.RGBA.rGBAIsOpaque",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-RGBA.html#v:rGBAIsOpaque"
        })


#endif

-- method RGBA::parse
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "rgba"
--           , argType = TInterface Name { namespace = "Gdk" , name = "RGBA" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the `GdkRGBA` to fill in"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "spec"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the string specifying the color"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_rgba_parse" gdk_rgba_parse :: 
    Ptr RGBA ->                             -- rgba : TInterface (Name {namespace = "Gdk", name = "RGBA"})
    CString ->                              -- spec : TBasicType TUTF8
    IO CInt

-- | Parses a textual representation of a color.
-- 
-- The string can be either one of:
-- 
-- * A standard name (Taken from the CSS specification).
-- * A hexadecimal value in the form “#rgb”, “#rrggbb”,
-- “#rrrgggbbb” or ”#rrrrggggbbbb”
-- * A hexadecimal value in the form “#rgba”, “#rrggbbaa”,
-- or ”#rrrrggggbbbbaaaa”
-- * A RGB color in the form “rgb(r,g,b)” (In this case the color
-- will have full opacity)
-- * A RGBA color in the form “rgba(r,g,b,a)”
-- * A HSL color in the form \"hsl(hue, saturation, lightness)\"
-- * A HSLA color in the form \"hsla(hue, saturation, lightness, alpha)\"
-- 
-- 
-- Where “r”, “g”, “b” and “a” are respectively the red, green,
-- blue and alpha color values. In the last two cases, “r”, “g”,
-- and “b” are either integers in the range 0 to 255 or percentage
-- values in the range 0% to 100%, and a is a floating point value
-- in the range 0 to 1.
rGBAParse ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RGBA
    -- ^ /@rgba@/: the @GdkRGBA@ to fill in
    -> T.Text
    -- ^ /@spec@/: the string specifying the color
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the parsing succeeded
rGBAParse :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
RGBA -> Text -> m Bool
rGBAParse RGBA
rgba Text
spec = 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
    rgba' <- RGBA -> IO (Ptr RGBA)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RGBA
rgba
    spec' <- textToCString spec
    result <- gdk_rgba_parse rgba' spec'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr rgba
    freeMem spec'
    return result'

#if defined(ENABLE_OVERLOADING)
data RGBAParseMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m) => O.OverloadedMethod RGBAParseMethodInfo RGBA signature where
    overloadedMethod = rGBAParse

instance O.OverloadedMethodInfo RGBAParseMethodInfo RGBA where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.RGBA.rGBAParse",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-RGBA.html#v:rGBAParse"
        })


#endif

-- method RGBA::to_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "rgba"
--           , argType = TInterface Name { namespace = "Gdk" , name = "RGBA" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkRGBA`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_rgba_to_string" gdk_rgba_to_string :: 
    Ptr RGBA ->                             -- rgba : TInterface (Name {namespace = "Gdk", name = "RGBA"})
    IO CString

-- | Returns a textual specification of /@rgba@/ in the form
-- @rgb(r,g,b)@ or @rgba(r,g,b,a)@, where “r”, “g”, “b” and
-- “a” represent the red, green, blue and alpha values
-- respectively. “r”, “g”, and “b” are represented as integers
-- in the range 0 to 255, and “a” is represented as a floating
-- point value in the range 0 to 1.
-- 
-- These string forms are string forms that are supported by
-- the CSS3 colors module, and can be parsed by 'GI.Gdk.Structs.RGBA.rGBAParse'.
-- 
-- Note that this string representation may lose some precision,
-- since “r”, “g” and “b” are represented as 8-bit integers. If
-- this is a concern, you should use a different representation.
rGBAToString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RGBA
    -- ^ /@rgba@/: a @GdkRGBA@
    -> m T.Text
    -- ^ __Returns:__ A newly allocated text string
rGBAToString :: forall (m :: * -> *). (HasCallStack, MonadIO m) => RGBA -> m Text
rGBAToString RGBA
rgba = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    rgba' <- RGBA -> IO (Ptr RGBA)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RGBA
rgba
    result <- gdk_rgba_to_string rgba'
    checkUnexpectedReturnNULL "rGBAToString" result
    result' <- cstringToText result
    freeMem result
    touchManagedPtr rgba
    return result'

#if defined(ENABLE_OVERLOADING)
data RGBAToStringMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod RGBAToStringMethodInfo RGBA signature where
    overloadedMethod = rGBAToString

instance O.OverloadedMethodInfo RGBAToStringMethodInfo RGBA where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.RGBA.rGBAToString",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-RGBA.html#v:rGBAToString"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveRGBAMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveRGBAMethod "copy" o = RGBACopyMethodInfo
    ResolveRGBAMethod "equal" o = RGBAEqualMethodInfo
    ResolveRGBAMethod "free" o = RGBAFreeMethodInfo
    ResolveRGBAMethod "hash" o = RGBAHashMethodInfo
    ResolveRGBAMethod "isClear" o = RGBAIsClearMethodInfo
    ResolveRGBAMethod "isOpaque" o = RGBAIsOpaqueMethodInfo
    ResolveRGBAMethod "parse" o = RGBAParseMethodInfo
    ResolveRGBAMethod "toString" o = RGBAToStringMethodInfo
    ResolveRGBAMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif