{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Color representation.

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

module GI.Clutter.Structs.Color
    ( 

-- * Exported types
    Color(..)                               ,
    newZeroColor                            ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [add]("GI.Clutter.Structs.Color#g:method:add"), [copy]("GI.Clutter.Structs.Color#g:method:copy"), [darken]("GI.Clutter.Structs.Color#g:method:darken"), [equal]("GI.Clutter.Structs.Color#g:method:equal"), [free]("GI.Clutter.Structs.Color#g:method:free"), [hash]("GI.Clutter.Structs.Color#g:method:hash"), [init]("GI.Clutter.Structs.Color#g:method:init"), [interpolate]("GI.Clutter.Structs.Color#g:method:interpolate"), [lighten]("GI.Clutter.Structs.Color#g:method:lighten"), [shade]("GI.Clutter.Structs.Color#g:method:shade"), [subtract]("GI.Clutter.Structs.Color#g:method:subtract"), [toHls]("GI.Clutter.Structs.Color#g:method:toHls"), [toPixel]("GI.Clutter.Structs.Color#g:method:toPixel"), [toString]("GI.Clutter.Structs.Color#g:method:toString").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveColorMethod                      ,
#endif

-- ** add #method:add#

#if defined(ENABLE_OVERLOADING)
    ColorAddMethodInfo                      ,
#endif
    colorAdd                                ,


-- ** alloc #method:alloc#

    colorAlloc                              ,


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    ColorCopyMethodInfo                     ,
#endif
    colorCopy                               ,


-- ** darken #method:darken#

#if defined(ENABLE_OVERLOADING)
    ColorDarkenMethodInfo                   ,
#endif
    colorDarken                             ,


-- ** equal #method:equal#

#if defined(ENABLE_OVERLOADING)
    ColorEqualMethodInfo                    ,
#endif
    colorEqual                              ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    ColorFreeMethodInfo                     ,
#endif
    colorFree                               ,


-- ** fromHls #method:fromHls#

    colorFromHls                            ,


-- ** fromPixel #method:fromPixel#

    colorFromPixel                          ,


-- ** fromString #method:fromString#

    colorFromString                         ,


-- ** getStatic #method:getStatic#

    colorGetStatic                          ,


-- ** hash #method:hash#

#if defined(ENABLE_OVERLOADING)
    ColorHashMethodInfo                     ,
#endif
    colorHash                               ,


-- ** init #method:init#

#if defined(ENABLE_OVERLOADING)
    ColorInitMethodInfo                     ,
#endif
    colorInit                               ,


-- ** interpolate #method:interpolate#

#if defined(ENABLE_OVERLOADING)
    ColorInterpolateMethodInfo              ,
#endif
    colorInterpolate                        ,


-- ** lighten #method:lighten#

#if defined(ENABLE_OVERLOADING)
    ColorLightenMethodInfo                  ,
#endif
    colorLighten                            ,


-- ** new #method:new#

    colorNew                                ,


-- ** shade #method:shade#

#if defined(ENABLE_OVERLOADING)
    ColorShadeMethodInfo                    ,
#endif
    colorShade                              ,


-- ** subtract #method:subtract#

#if defined(ENABLE_OVERLOADING)
    ColorSubtractMethodInfo                 ,
#endif
    colorSubtract                           ,


-- ** toHls #method:toHls#

#if defined(ENABLE_OVERLOADING)
    ColorToHlsMethodInfo                    ,
#endif
    colorToHls                              ,


-- ** toPixel #method:toPixel#

#if defined(ENABLE_OVERLOADING)
    ColorToPixelMethodInfo                  ,
#endif
    colorToPixel                            ,


-- ** toString #method:toString#

#if defined(ENABLE_OVERLOADING)
    ColorToStringMethodInfo                 ,
#endif
    colorToString                           ,




 -- * Properties


-- ** alpha #attr:alpha#
-- | alpha component, between 0 and 255

#if defined(ENABLE_OVERLOADING)
    color_alpha                             ,
#endif
    getColorAlpha                           ,
    setColorAlpha                           ,


-- ** blue #attr:blue#
-- | blue component, between 0 and 255

#if defined(ENABLE_OVERLOADING)
    color_blue                              ,
#endif
    getColorBlue                            ,
    setColorBlue                            ,


-- ** green #attr:green#
-- | green component, between 0 and 255

#if defined(ENABLE_OVERLOADING)
    color_green                             ,
#endif
    getColorGreen                           ,
    setColorGreen                           ,


-- ** red #attr:red#
-- | red component, between 0 and 255

#if defined(ENABLE_OVERLOADING)
    color_red                               ,
#endif
    getColorRed                             ,
    setColorRed                             ,




    ) where

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

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

import {-# SOURCE #-} qualified GI.Clutter.Enums as Clutter.Enums

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

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

foreign import ccall "clutter_color_get_type" c_clutter_color_get_type :: 
    IO GType

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

instance B.Types.TypedObject Color where
    glibType :: IO GType
glibType = IO GType
c_clutter_color_get_type

instance B.Types.GBoxed Color

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

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

instance tag ~ 'AttrSet => Constructible Color tag where
    new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr Color -> Color) -> [AttrOp Color tag] -> m Color
new ManagedPtr Color -> Color
_ [AttrOp Color tag]
attrs = do
        Color
o <- m Color
forall (m :: * -> *). MonadIO m => m Color
newZeroColor
        Color -> [AttrOp Color 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set Color
o [AttrOp Color tag]
[AttrOp Color 'AttrSet]
attrs
        Color -> m Color
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Color
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' color #red
-- @
getColorRed :: MonadIO m => Color -> m Word8
getColorRed :: forall (m :: * -> *). MonadIO m => Color -> m Word8
getColorRed Color
s = IO Word8 -> m Word8
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word8 -> m Word8) -> IO Word8 -> m Word8
forall a b. (a -> b) -> a -> b
$ Color -> (Ptr Color -> IO Word8) -> IO Word8
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Color
s ((Ptr Color -> IO Word8) -> IO Word8)
-> (Ptr Color -> IO Word8) -> IO Word8
forall a b. (a -> b) -> a -> b
$ \Ptr Color
ptr -> do
    Word8
val <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (Ptr Color
ptr Ptr Color -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO Word8
    Word8 -> IO Word8
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
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' color [ #red 'Data.GI.Base.Attributes.:=' value ]
-- @
setColorRed :: MonadIO m => Color -> Word8 -> m ()
setColorRed :: forall (m :: * -> *). MonadIO m => Color -> Word8 -> m ()
setColorRed Color
s Word8
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
$ Color -> (Ptr Color -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Color
s ((Ptr Color -> IO ()) -> IO ()) -> (Ptr Color -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Color
ptr -> do
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Color
ptr Ptr Color -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (Word8
val :: Word8)

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

color_red :: AttrLabelProxy "red"
color_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' color #green
-- @
getColorGreen :: MonadIO m => Color -> m Word8
getColorGreen :: forall (m :: * -> *). MonadIO m => Color -> m Word8
getColorGreen Color
s = IO Word8 -> m Word8
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word8 -> m Word8) -> IO Word8 -> m Word8
forall a b. (a -> b) -> a -> b
$ Color -> (Ptr Color -> IO Word8) -> IO Word8
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Color
s ((Ptr Color -> IO Word8) -> IO Word8)
-> (Ptr Color -> IO Word8) -> IO Word8
forall a b. (a -> b) -> a -> b
$ \Ptr Color
ptr -> do
    Word8
val <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (Ptr Color
ptr Ptr Color -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) :: IO Word8
    Word8 -> IO Word8
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
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' color [ #green 'Data.GI.Base.Attributes.:=' value ]
-- @
setColorGreen :: MonadIO m => Color -> Word8 -> m ()
setColorGreen :: forall (m :: * -> *). MonadIO m => Color -> Word8 -> m ()
setColorGreen Color
s Word8
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
$ Color -> (Ptr Color -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Color
s ((Ptr Color -> IO ()) -> IO ()) -> (Ptr Color -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Color
ptr -> do
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Color
ptr Ptr Color -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Word8
val :: Word8)

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

color_green :: AttrLabelProxy "green"
color_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' color #blue
-- @
getColorBlue :: MonadIO m => Color -> m Word8
getColorBlue :: forall (m :: * -> *). MonadIO m => Color -> m Word8
getColorBlue Color
s = IO Word8 -> m Word8
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word8 -> m Word8) -> IO Word8 -> m Word8
forall a b. (a -> b) -> a -> b
$ Color -> (Ptr Color -> IO Word8) -> IO Word8
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Color
s ((Ptr Color -> IO Word8) -> IO Word8)
-> (Ptr Color -> IO Word8) -> IO Word8
forall a b. (a -> b) -> a -> b
$ \Ptr Color
ptr -> do
    Word8
val <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (Ptr Color
ptr Ptr Color -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2) :: IO Word8
    Word8 -> IO Word8
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
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' color [ #blue 'Data.GI.Base.Attributes.:=' value ]
-- @
setColorBlue :: MonadIO m => Color -> Word8 -> m ()
setColorBlue :: forall (m :: * -> *). MonadIO m => Color -> Word8 -> m ()
setColorBlue Color
s Word8
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
$ Color -> (Ptr Color -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Color
s ((Ptr Color -> IO ()) -> IO ()) -> (Ptr Color -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Color
ptr -> do
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Color
ptr Ptr Color -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2) (Word8
val :: Word8)

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

color_blue :: AttrLabelProxy "blue"
color_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' color #alpha
-- @
getColorAlpha :: MonadIO m => Color -> m Word8
getColorAlpha :: forall (m :: * -> *). MonadIO m => Color -> m Word8
getColorAlpha Color
s = IO Word8 -> m Word8
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word8 -> m Word8) -> IO Word8 -> m Word8
forall a b. (a -> b) -> a -> b
$ Color -> (Ptr Color -> IO Word8) -> IO Word8
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Color
s ((Ptr Color -> IO Word8) -> IO Word8)
-> (Ptr Color -> IO Word8) -> IO Word8
forall a b. (a -> b) -> a -> b
$ \Ptr Color
ptr -> do
    Word8
val <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (Ptr Color
ptr Ptr Color -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3) :: IO Word8
    Word8 -> IO Word8
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
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' color [ #alpha 'Data.GI.Base.Attributes.:=' value ]
-- @
setColorAlpha :: MonadIO m => Color -> Word8 -> m ()
setColorAlpha :: forall (m :: * -> *). MonadIO m => Color -> Word8 -> m ()
setColorAlpha Color
s Word8
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
$ Color -> (Ptr Color -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Color
s ((Ptr Color -> IO ()) -> IO ()) -> (Ptr Color -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Color
ptr -> do
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Color
ptr Ptr Color -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3) (Word8
val :: Word8)

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

color_alpha :: AttrLabelProxy "alpha"
color_alpha = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Color
type instance O.AttributeList Color = ColorAttributeList
type ColorAttributeList = ('[ '("red", ColorRedFieldInfo), '("green", ColorGreenFieldInfo), '("blue", ColorBlueFieldInfo), '("alpha", ColorAlphaFieldInfo)] :: [(Symbol, DK.Type)])
#endif

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

foreign import ccall "clutter_color_alloc" clutter_color_alloc :: 
    IO (Ptr Color)

-- | Allocates a new, transparent black t'GI.Clutter.Structs.Color.Color'.
-- 
-- /Since: 1.12/
colorAlloc ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Color
    -- ^ __Returns:__ the newly allocated t'GI.Clutter.Structs.Color.Color'; use
    --   'GI.Clutter.Structs.Color.colorFree' to free its resources
colorAlloc :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Color
colorAlloc  = IO Color -> m Color
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Color -> m Color) -> IO Color -> m Color
forall a b. (a -> b) -> a -> b
$ do
    Ptr Color
result <- IO (Ptr Color)
clutter_color_alloc
    Text -> Ptr Color -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"colorAlloc" Ptr Color
result
    Color
result' <- ((ManagedPtr Color -> Color) -> Ptr Color -> IO Color
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Color -> Color
Color) Ptr Color
result
    Color -> IO Color
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Color
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Color::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "red"
--           , argType = TBasicType TUInt8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "red component of the color, between 0 and 255"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "green"
--           , argType = TBasicType TUInt8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "green component of the color, between 0 and 255"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "blue"
--           , argType = TBasicType TUInt8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "blue component of the color, between 0 and 255"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "alpha"
--           , argType = TBasicType TUInt8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "alpha component of the color, between 0 and 255"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Clutter" , name = "Color" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_color_new" clutter_color_new :: 
    Word8 ->                                -- red : TBasicType TUInt8
    Word8 ->                                -- green : TBasicType TUInt8
    Word8 ->                                -- blue : TBasicType TUInt8
    Word8 ->                                -- alpha : TBasicType TUInt8
    IO (Ptr Color)

-- | Creates a new t'GI.Clutter.Structs.Color.Color' with the given values.
-- 
-- This function is the equivalent of:
-- 
-- >
-- >  clutter_color_init (clutter_color_alloc (), red, green, blue, alpha);
-- 
-- 
-- /Since: 0.8/
colorNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Word8
    -- ^ /@red@/: red component of the color, between 0 and 255
    -> Word8
    -- ^ /@green@/: green component of the color, between 0 and 255
    -> Word8
    -- ^ /@blue@/: blue component of the color, between 0 and 255
    -> Word8
    -- ^ /@alpha@/: alpha component of the color, between 0 and 255
    -> m Color
    -- ^ __Returns:__ the newly allocated color.
    --   Use 'GI.Clutter.Structs.Color.colorFree' when done
colorNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Word8 -> Word8 -> Word8 -> Word8 -> m Color
colorNew Word8
red Word8
green Word8
blue Word8
alpha = IO Color -> m Color
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Color -> m Color) -> IO Color -> m Color
forall a b. (a -> b) -> a -> b
$ do
    Ptr Color
result <- Word8 -> Word8 -> Word8 -> Word8 -> IO (Ptr Color)
clutter_color_new Word8
red Word8
green Word8
blue Word8
alpha
    Text -> Ptr Color -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"colorNew" Ptr Color
result
    Color
result' <- ((ManagedPtr Color -> Color) -> Ptr Color -> IO Color
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Color -> Color
Color) Ptr Color
result
    Color -> IO Color
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Color
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "clutter_color_add" clutter_color_add :: 
    Ptr Color ->                            -- a : TInterface (Name {namespace = "Clutter", name = "Color"})
    Ptr Color ->                            -- b : TInterface (Name {namespace = "Clutter", name = "Color"})
    Ptr Color ->                            -- result : TInterface (Name {namespace = "Clutter", name = "Color"})
    IO ()

-- | Adds /@a@/ to /@b@/ and saves the resulting color inside /@result@/.
-- 
-- The alpha channel of /@result@/ is set as as the maximum value
-- between the alpha channels of /@a@/ and /@b@/.
colorAdd ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@a@/: a t'GI.Clutter.Structs.Color.Color'
    -> Color
    -- ^ /@b@/: a t'GI.Clutter.Structs.Color.Color'
    -> m (Color)
colorAdd :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Color -> Color -> m Color
colorAdd Color
a Color
b = IO Color -> m Color
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Color -> m Color) -> IO Color -> m Color
forall a b. (a -> b) -> a -> b
$ do
    Ptr Color
a' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
a
    Ptr Color
b' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
b
    Ptr Color
result_ <- Int -> IO (Ptr Color)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
4 :: IO (Ptr Color)
    Ptr Color -> Ptr Color -> Ptr Color -> IO ()
clutter_color_add Ptr Color
a' Ptr Color
b' Ptr Color
result_
    Color
result_' <- ((ManagedPtr Color -> Color) -> Ptr Color -> IO Color
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Color -> Color
Color) Ptr Color
result_
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
a
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
b
    Color -> IO Color
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Color
result_'

#if defined(ENABLE_OVERLOADING)
data ColorAddMethodInfo
instance (signature ~ (Color -> m (Color)), MonadIO m) => O.OverloadedMethod ColorAddMethodInfo Color signature where
    overloadedMethod = colorAdd

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


#endif

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

foreign import ccall "clutter_color_copy" clutter_color_copy :: 
    Ptr Color ->                            -- color : TInterface (Name {namespace = "Clutter", name = "Color"})
    IO (Ptr Color)

-- | Makes a copy of the color structure.  The result must be
-- freed using 'GI.Clutter.Structs.Color.colorFree'.
-- 
-- /Since: 0.2/
colorCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: a t'GI.Clutter.Structs.Color.Color'
    -> m Color
    -- ^ __Returns:__ an allocated copy of /@color@/.
colorCopy :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Color -> m Color
colorCopy Color
color = IO Color -> m Color
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Color -> m Color) -> IO Color -> m Color
forall a b. (a -> b) -> a -> b
$ do
    Ptr Color
color' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
color
    Ptr Color
result <- Ptr Color -> IO (Ptr Color)
clutter_color_copy Ptr Color
color'
    Text -> Ptr Color -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"colorCopy" Ptr Color
result
    Color
result' <- ((ManagedPtr Color -> Color) -> Ptr Color -> IO Color
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Color -> Color
Color) Ptr Color
result
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
color
    Color -> IO Color
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Color
result'

#if defined(ENABLE_OVERLOADING)
data ColorCopyMethodInfo
instance (signature ~ (m Color), MonadIO m) => O.OverloadedMethod ColorCopyMethodInfo Color signature where
    overloadedMethod = colorCopy

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


#endif

-- method Color::darken
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "color"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterColor" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Color" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the darker color"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_color_darken" clutter_color_darken :: 
    Ptr Color ->                            -- color : TInterface (Name {namespace = "Clutter", name = "Color"})
    Ptr Color ->                            -- result : TInterface (Name {namespace = "Clutter", name = "Color"})
    IO ()

-- | Darkens /@color@/ by a fixed amount, and saves the changed color
-- in /@result@/.
colorDarken ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: a t'GI.Clutter.Structs.Color.Color'
    -> m (Color)
colorDarken :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Color -> m Color
colorDarken Color
color = IO Color -> m Color
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Color -> m Color) -> IO Color -> m Color
forall a b. (a -> b) -> a -> b
$ do
    Ptr Color
color' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
color
    Ptr Color
result_ <- Int -> IO (Ptr Color)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
4 :: IO (Ptr Color)
    Ptr Color -> Ptr Color -> IO ()
clutter_color_darken Ptr Color
color' Ptr Color
result_
    Color
result_' <- ((ManagedPtr Color -> Color) -> Ptr Color -> IO Color
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Color -> Color
Color) Ptr Color
result_
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
color
    Color -> IO Color
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Color
result_'

#if defined(ENABLE_OVERLOADING)
data ColorDarkenMethodInfo
instance (signature ~ (m (Color)), MonadIO m) => O.OverloadedMethod ColorDarkenMethodInfo Color signature where
    overloadedMethod = colorDarken

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


#endif

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

foreign import ccall "clutter_color_equal" clutter_color_equal :: 
    Ptr Color ->                            -- v1 : TInterface (Name {namespace = "Clutter", name = "Color"})
    Ptr Color ->                            -- v2 : TInterface (Name {namespace = "Clutter", name = "Color"})
    IO CInt

-- | Compares two t'GI.Clutter.Structs.Color.Color's and checks if they are the same.
-- 
-- This function can be passed to @/g_hash_table_new()/@ as the /@keyEqualFunc@/
-- parameter, when using t'GI.Clutter.Structs.Color.Color's as keys in a t'GI.GLib.Structs.HashTable.HashTable'.
-- 
-- /Since: 0.2/
colorEqual ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@v1@/: a t'GI.Clutter.Structs.Color.Color'
    -> Color
    -- ^ /@v2@/: a t'GI.Clutter.Structs.Color.Color'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the two colors are the same.
colorEqual :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Color -> Color -> m Bool
colorEqual Color
v1 Color
v2 = 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 Color
v1' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
v1
    Ptr Color
v2' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
v2
    CInt
result <- Ptr Color -> Ptr Color -> IO CInt
clutter_color_equal Ptr Color
v1' Ptr Color
v2'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
v1
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
v2
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ColorEqualMethodInfo
instance (signature ~ (Color -> m Bool), MonadIO m) => O.OverloadedMethod ColorEqualMethodInfo Color signature where
    overloadedMethod = colorEqual

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


#endif

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

foreign import ccall "clutter_color_free" clutter_color_free :: 
    Ptr Color ->                            -- color : TInterface (Name {namespace = "Clutter", name = "Color"})
    IO ()

-- | Frees a color structure created with 'GI.Clutter.Structs.Color.colorCopy'.
-- 
-- /Since: 0.2/
colorFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: a t'GI.Clutter.Structs.Color.Color'
    -> m ()
colorFree :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Color -> m ()
colorFree Color
color = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Color
color' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
color
    Ptr Color -> IO ()
clutter_color_free Ptr Color
color'
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
color
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ColorFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod ColorFreeMethodInfo Color signature where
    overloadedMethod = colorFree

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


#endif

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

foreign import ccall "clutter_color_hash" clutter_color_hash :: 
    Ptr Color ->                            -- v : TInterface (Name {namespace = "Clutter", name = "Color"})
    IO Word32

-- | Converts a t'GI.Clutter.Structs.Color.Color' to a hash value.
-- 
-- This function can be passed to @/g_hash_table_new()/@ as the /@hashFunc@/
-- parameter, when using t'GI.Clutter.Structs.Color.Color's as keys in a t'GI.GLib.Structs.HashTable.HashTable'.
-- 
-- /Since: 1.0/
colorHash ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@v@/: a t'GI.Clutter.Structs.Color.Color'
    -> m Word32
    -- ^ __Returns:__ a hash value corresponding to the color
colorHash :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Color -> m Word32
colorHash Color
v = 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
    Ptr Color
v' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
v
    Word32
result <- Ptr Color -> IO Word32
clutter_color_hash Ptr Color
v'
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
v
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data ColorHashMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.OverloadedMethod ColorHashMethodInfo Color signature where
    overloadedMethod = colorHash

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


#endif

-- method Color::init
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "color"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterColor" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "red"
--           , argType = TBasicType TUInt8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "red component of the color, between 0 and 255"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "green"
--           , argType = TBasicType TUInt8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "green component of the color, between 0 and 255"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "blue"
--           , argType = TBasicType TUInt8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "blue component of the color, between 0 and 255"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "alpha"
--           , argType = TBasicType TUInt8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "alpha component of the color, between 0 and 255"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Clutter" , name = "Color" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_color_init" clutter_color_init :: 
    Ptr Color ->                            -- color : TInterface (Name {namespace = "Clutter", name = "Color"})
    Word8 ->                                -- red : TBasicType TUInt8
    Word8 ->                                -- green : TBasicType TUInt8
    Word8 ->                                -- blue : TBasicType TUInt8
    Word8 ->                                -- alpha : TBasicType TUInt8
    IO (Ptr Color)

-- | Initializes /@color@/ with the given values.
-- 
-- /Since: 1.12/
colorInit ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: a t'GI.Clutter.Structs.Color.Color'
    -> Word8
    -- ^ /@red@/: red component of the color, between 0 and 255
    -> Word8
    -- ^ /@green@/: green component of the color, between 0 and 255
    -> Word8
    -- ^ /@blue@/: blue component of the color, between 0 and 255
    -> Word8
    -- ^ /@alpha@/: alpha component of the color, between 0 and 255
    -> m Color
    -- ^ __Returns:__ the initialized t'GI.Clutter.Structs.Color.Color'
colorInit :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Color -> Word8 -> Word8 -> Word8 -> Word8 -> m Color
colorInit Color
color Word8
red Word8
green Word8
blue Word8
alpha = IO Color -> m Color
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Color -> m Color) -> IO Color -> m Color
forall a b. (a -> b) -> a -> b
$ do
    Ptr Color
color' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
color
    Ptr Color
result <- Ptr Color -> Word8 -> Word8 -> Word8 -> Word8 -> IO (Ptr Color)
clutter_color_init Ptr Color
color' Word8
red Word8
green Word8
blue Word8
alpha
    Text -> Ptr Color -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"colorInit" Ptr Color
result
    Color
result' <- ((ManagedPtr Color -> Color) -> Ptr Color -> IO Color
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Color -> Color
Color) Ptr Color
result
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
color
    Color -> IO Color
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Color
result'

#if defined(ENABLE_OVERLOADING)
data ColorInitMethodInfo
instance (signature ~ (Word8 -> Word8 -> Word8 -> Word8 -> m Color), MonadIO m) => O.OverloadedMethod ColorInitMethodInfo Color signature where
    overloadedMethod = colorInit

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


#endif

-- method Color::interpolate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "initial"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the initial #ClutterColor"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "final"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the final #ClutterColor"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "progress"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the interpolation progress"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Color" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the interpolation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_color_interpolate" clutter_color_interpolate :: 
    Ptr Color ->                            -- initial : TInterface (Name {namespace = "Clutter", name = "Color"})
    Ptr Color ->                            -- final : TInterface (Name {namespace = "Clutter", name = "Color"})
    CDouble ->                              -- progress : TBasicType TDouble
    Ptr Color ->                            -- result : TInterface (Name {namespace = "Clutter", name = "Color"})
    IO ()

-- | Interpolates between /@initial@/ and /@final@/ t'GI.Clutter.Structs.Color.Color's
-- using /@progress@/
-- 
-- /Since: 1.6/
colorInterpolate ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@initial@/: the initial t'GI.Clutter.Structs.Color.Color'
    -> Color
    -- ^ /@final@/: the final t'GI.Clutter.Structs.Color.Color'
    -> Double
    -- ^ /@progress@/: the interpolation progress
    -> m (Color)
colorInterpolate :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Color -> Color -> Double -> m Color
colorInterpolate Color
initial Color
final Double
progress = IO Color -> m Color
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Color -> m Color) -> IO Color -> m Color
forall a b. (a -> b) -> a -> b
$ do
    Ptr Color
initial' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
initial
    Ptr Color
final' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
final
    let progress' :: CDouble
progress' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
progress
    Ptr Color
result_ <- Int -> IO (Ptr Color)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
4 :: IO (Ptr Color)
    Ptr Color -> Ptr Color -> CDouble -> Ptr Color -> IO ()
clutter_color_interpolate Ptr Color
initial' Ptr Color
final' CDouble
progress' Ptr Color
result_
    Color
result_' <- ((ManagedPtr Color -> Color) -> Ptr Color -> IO Color
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Color -> Color
Color) Ptr Color
result_
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
initial
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
final
    Color -> IO Color
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Color
result_'

#if defined(ENABLE_OVERLOADING)
data ColorInterpolateMethodInfo
instance (signature ~ (Color -> Double -> m (Color)), MonadIO m) => O.OverloadedMethod ColorInterpolateMethodInfo Color signature where
    overloadedMethod = colorInterpolate

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


#endif

-- method Color::lighten
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "color"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterColor" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Color" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the lighter color"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_color_lighten" clutter_color_lighten :: 
    Ptr Color ->                            -- color : TInterface (Name {namespace = "Clutter", name = "Color"})
    Ptr Color ->                            -- result : TInterface (Name {namespace = "Clutter", name = "Color"})
    IO ()

-- | Lightens /@color@/ by a fixed amount, and saves the changed color
-- in /@result@/.
colorLighten ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: a t'GI.Clutter.Structs.Color.Color'
    -> m (Color)
colorLighten :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Color -> m Color
colorLighten Color
color = IO Color -> m Color
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Color -> m Color) -> IO Color -> m Color
forall a b. (a -> b) -> a -> b
$ do
    Ptr Color
color' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
color
    Ptr Color
result_ <- Int -> IO (Ptr Color)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
4 :: IO (Ptr Color)
    Ptr Color -> Ptr Color -> IO ()
clutter_color_lighten Ptr Color
color' Ptr Color
result_
    Color
result_' <- ((ManagedPtr Color -> Color) -> Ptr Color -> IO Color
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Color -> Color
Color) Ptr Color
result_
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
color
    Color -> IO Color
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Color
result_'

#if defined(ENABLE_OVERLOADING)
data ColorLightenMethodInfo
instance (signature ~ (m (Color)), MonadIO m) => O.OverloadedMethod ColorLightenMethodInfo Color signature where
    overloadedMethod = colorLighten

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


#endif

-- method Color::shade
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "color"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterColor" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "factor"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the shade factor to apply"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Color" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the shaded color"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_color_shade" clutter_color_shade :: 
    Ptr Color ->                            -- color : TInterface (Name {namespace = "Clutter", name = "Color"})
    CDouble ->                              -- factor : TBasicType TDouble
    Ptr Color ->                            -- result : TInterface (Name {namespace = "Clutter", name = "Color"})
    IO ()

-- | Shades /@color@/ by /@factor@/ and saves the modified color into /@result@/.
colorShade ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: a t'GI.Clutter.Structs.Color.Color'
    -> Double
    -- ^ /@factor@/: the shade factor to apply
    -> m (Color)
colorShade :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Color -> Double -> m Color
colorShade Color
color Double
factor = IO Color -> m Color
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Color -> m Color) -> IO Color -> m Color
forall a b. (a -> b) -> a -> b
$ do
    Ptr Color
color' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
color
    let factor' :: CDouble
factor' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
factor
    Ptr Color
result_ <- Int -> IO (Ptr Color)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
4 :: IO (Ptr Color)
    Ptr Color -> CDouble -> Ptr Color -> IO ()
clutter_color_shade Ptr Color
color' CDouble
factor' Ptr Color
result_
    Color
result_' <- ((ManagedPtr Color -> Color) -> Ptr Color -> IO Color
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Color -> Color
Color) Ptr Color
result_
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
color
    Color -> IO Color
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Color
result_'

#if defined(ENABLE_OVERLOADING)
data ColorShadeMethodInfo
instance (signature ~ (Double -> m (Color)), MonadIO m) => O.OverloadedMethod ColorShadeMethodInfo Color signature where
    overloadedMethod = colorShade

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


#endif

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

foreign import ccall "clutter_color_subtract" clutter_color_subtract :: 
    Ptr Color ->                            -- a : TInterface (Name {namespace = "Clutter", name = "Color"})
    Ptr Color ->                            -- b : TInterface (Name {namespace = "Clutter", name = "Color"})
    Ptr Color ->                            -- result : TInterface (Name {namespace = "Clutter", name = "Color"})
    IO ()

-- | Subtracts /@b@/ from /@a@/ and saves the resulting color inside /@result@/.
-- 
-- This function assumes that the components of /@a@/ are greater than the
-- components of /@b@/; the result is, otherwise, undefined.
-- 
-- The alpha channel of /@result@/ is set as the minimum value
-- between the alpha channels of /@a@/ and /@b@/.
colorSubtract ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@a@/: a t'GI.Clutter.Structs.Color.Color'
    -> Color
    -- ^ /@b@/: a t'GI.Clutter.Structs.Color.Color'
    -> m (Color)
colorSubtract :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Color -> Color -> m Color
colorSubtract Color
a Color
b = IO Color -> m Color
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Color -> m Color) -> IO Color -> m Color
forall a b. (a -> b) -> a -> b
$ do
    Ptr Color
a' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
a
    Ptr Color
b' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
b
    Ptr Color
result_ <- Int -> IO (Ptr Color)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
4 :: IO (Ptr Color)
    Ptr Color -> Ptr Color -> Ptr Color -> IO ()
clutter_color_subtract Ptr Color
a' Ptr Color
b' Ptr Color
result_
    Color
result_' <- ((ManagedPtr Color -> Color) -> Ptr Color -> IO Color
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Color -> Color
Color) Ptr Color
result_
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
a
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
b
    Color -> IO Color
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Color
result_'

#if defined(ENABLE_OVERLOADING)
data ColorSubtractMethodInfo
instance (signature ~ (Color -> m (Color)), MonadIO m) => O.OverloadedMethod ColorSubtractMethodInfo Color signature where
    overloadedMethod = colorSubtract

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


#endif

-- method Color::to_hls
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "color"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterColor" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "hue"
--           , argType = TBasicType TFloat
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the hue value or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "luminance"
--           , argType = TBasicType TFloat
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for the luminance value or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "saturation"
--           , argType = TBasicType TFloat
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for the saturation value or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_color_to_hls" clutter_color_to_hls :: 
    Ptr Color ->                            -- color : TInterface (Name {namespace = "Clutter", name = "Color"})
    Ptr CFloat ->                           -- hue : TBasicType TFloat
    Ptr CFloat ->                           -- luminance : TBasicType TFloat
    Ptr CFloat ->                           -- saturation : TBasicType TFloat
    IO ()

-- | Converts /@color@/ to the HLS format.
-- 
-- The /@hue@/ value is in the 0 .. 360 range. The /@luminance@/ and
-- /@saturation@/ values are in the 0 .. 1 range.
colorToHls ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: a t'GI.Clutter.Structs.Color.Color'
    -> m ((Float, Float, Float))
colorToHls :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Color -> m (Float, Float, Float)
colorToHls Color
color = IO (Float, Float, Float) -> m (Float, Float, Float)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Float, Float, Float) -> m (Float, Float, Float))
-> IO (Float, Float, Float) -> m (Float, Float, Float)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Color
color' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
color
    Ptr CFloat
hue <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    Ptr CFloat
luminance <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    Ptr CFloat
saturation <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    Ptr Color -> Ptr CFloat -> Ptr CFloat -> Ptr CFloat -> IO ()
clutter_color_to_hls Ptr Color
color' Ptr CFloat
hue Ptr CFloat
luminance Ptr CFloat
saturation
    CFloat
hue' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
hue
    let hue'' :: Float
hue'' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
hue'
    CFloat
luminance' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
luminance
    let luminance'' :: Float
luminance'' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
luminance'
    CFloat
saturation' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
saturation
    let saturation'' :: Float
saturation'' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
saturation'
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
color
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
hue
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
luminance
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
saturation
    (Float, Float, Float) -> IO (Float, Float, Float)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Float
hue'', Float
luminance'', Float
saturation'')

#if defined(ENABLE_OVERLOADING)
data ColorToHlsMethodInfo
instance (signature ~ (m ((Float, Float, Float))), MonadIO m) => O.OverloadedMethod ColorToHlsMethodInfo Color signature where
    overloadedMethod = colorToHls

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


#endif

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

foreign import ccall "clutter_color_to_pixel" clutter_color_to_pixel :: 
    Ptr Color ->                            -- color : TInterface (Name {namespace = "Clutter", name = "Color"})
    IO Word32

-- | Converts /@color@/ into a packed 32 bit integer, containing
-- all the four 8 bit channels used by t'GI.Clutter.Structs.Color.Color'.
colorToPixel ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: a t'GI.Clutter.Structs.Color.Color'
    -> m Word32
    -- ^ __Returns:__ a packed color
colorToPixel :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Color -> m Word32
colorToPixel Color
color = 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
    Ptr Color
color' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
color
    Word32
result <- Ptr Color -> IO Word32
clutter_color_to_pixel Ptr Color
color'
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
color
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data ColorToPixelMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.OverloadedMethod ColorToPixelMethodInfo Color signature where
    overloadedMethod = colorToPixel

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


#endif

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

foreign import ccall "clutter_color_to_string" clutter_color_to_string :: 
    Ptr Color ->                            -- color : TInterface (Name {namespace = "Clutter", name = "Color"})
    IO CString

-- | Returns a textual specification of /@color@/ in the hexadecimal form
-- \<literal>&num;rrggbbaa\<\/literal>, where \<literal>r\<\/literal>,
-- \<literal>g\<\/literal>, \<literal>b\<\/literal> and \<literal>a\<\/literal> are
-- hexadecimal digits representing the red, green, blue and alpha components
-- respectively.
-- 
-- /Since: 0.2/
colorToString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: a t'GI.Clutter.Structs.Color.Color'
    -> m T.Text
    -- ^ __Returns:__ a newly-allocated text string
colorToString :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Color -> m Text
colorToString Color
color = 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
    Ptr Color
color' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
color
    CString
result <- Ptr Color -> IO CString
clutter_color_to_string Ptr Color
color'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"colorToString" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
color
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data ColorToStringMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod ColorToStringMethodInfo Color signature where
    overloadedMethod = colorToString

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


#endif

-- method Color::from_hls
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "color"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Color" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for a #ClutterColor"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "hue"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "hue value, in the 0 .. 360 range"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "luminance"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "luminance value, in the 0 .. 1 range"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "saturation"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "saturation value, in the 0 .. 1 range"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_color_from_hls" clutter_color_from_hls :: 
    Ptr Color ->                            -- color : TInterface (Name {namespace = "Clutter", name = "Color"})
    CFloat ->                               -- hue : TBasicType TFloat
    CFloat ->                               -- luminance : TBasicType TFloat
    CFloat ->                               -- saturation : TBasicType TFloat
    IO ()

-- | Converts a color expressed in HLS (hue, luminance and saturation)
-- values into a t'GI.Clutter.Structs.Color.Color'.
colorFromHls ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Float
    -- ^ /@hue@/: hue value, in the 0 .. 360 range
    -> Float
    -- ^ /@luminance@/: luminance value, in the 0 .. 1 range
    -> Float
    -- ^ /@saturation@/: saturation value, in the 0 .. 1 range
    -> m (Color)
colorFromHls :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Float -> Float -> Float -> m Color
colorFromHls Float
hue Float
luminance Float
saturation = IO Color -> m Color
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Color -> m Color) -> IO Color -> m Color
forall a b. (a -> b) -> a -> b
$ do
    Ptr Color
color <- Int -> IO (Ptr Color)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
4 :: IO (Ptr Color)
    let hue' :: CFloat
hue' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
hue
    let luminance' :: CFloat
luminance' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
luminance
    let saturation' :: CFloat
saturation' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
saturation
    Ptr Color -> CFloat -> CFloat -> CFloat -> IO ()
clutter_color_from_hls Ptr Color
color CFloat
hue' CFloat
luminance' CFloat
saturation'
    Color
color' <- ((ManagedPtr Color -> Color) -> Ptr Color -> IO Color
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Color -> Color
Color) Ptr Color
color
    Color -> IO Color
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Color
color'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Color::from_pixel
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "color"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Color" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for a #ClutterColor"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pixel"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a 32 bit packed integer containing a color"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_color_from_pixel" clutter_color_from_pixel :: 
    Ptr Color ->                            -- color : TInterface (Name {namespace = "Clutter", name = "Color"})
    Word32 ->                               -- pixel : TBasicType TUInt32
    IO ()

-- | Converts /@pixel@/ from the packed representation of a four 8 bit channel
-- color to a t'GI.Clutter.Structs.Color.Color'.
colorFromPixel ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Word32
    -- ^ /@pixel@/: a 32 bit packed integer containing a color
    -> m (Color)
colorFromPixel :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Word32 -> m Color
colorFromPixel Word32
pixel = IO Color -> m Color
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Color -> m Color) -> IO Color -> m Color
forall a b. (a -> b) -> a -> b
$ do
    Ptr Color
color <- Int -> IO (Ptr Color)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
4 :: IO (Ptr Color)
    Ptr Color -> Word32 -> IO ()
clutter_color_from_pixel Ptr Color
color Word32
pixel
    Color
color' <- ((ManagedPtr Color -> Color) -> Ptr Color -> IO Color
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Color -> Color
Color) Ptr Color
color
    Color -> IO Color
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Color
color'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Color::from_string
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "color"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Color" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for a #ClutterColor"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "str"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a string specifiying a color"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_color_from_string" clutter_color_from_string :: 
    Ptr Color ->                            -- color : TInterface (Name {namespace = "Clutter", name = "Color"})
    CString ->                              -- str : TBasicType TUTF8
    IO CInt

-- | Parses a string definition of a color, filling the t'GI.Clutter.Structs.Color.Color'.@/red/@,
-- t'GI.Clutter.Structs.Color.Color'.@/green/@, t'GI.Clutter.Structs.Color.Color'.@/blue/@ and t'GI.Clutter.Structs.Color.Color'.@/alpha/@ fields
-- of /@color@/.
-- 
-- The /@color@/ is not allocated.
-- 
-- The format of /@str@/ can be either one of:
-- 
--   - a standard name (as taken from the X11 rgb.txt file)
--   - an hexadecimal value in the form: @#rgb@, @#rrggbb@, @#rgba@, or @#rrggbbaa@
--   - a RGB color in the form: @rgb(r, g, b)@
--   - a RGB color in the form: @rgba(r, g, b, a)@
--   - a HSL color in the form: @hsl(h, s, l)@
--    -a HSL color in the form: @hsla(h, s, l, a)@
-- 
-- where \'r\', \'g\', \'b\' and \'a\' are (respectively) the red, green, blue color
-- intensities and the opacity. The \'h\', \'s\' and \'l\' are (respectively) the
-- hue, saturation and luminance values.
-- 
-- In the @/rgb()/@ and @/rgba()/@ formats, the \'r\', \'g\', and \'b\' values are either
-- integers between 0 and 255, or percentage values in the range between 0%
-- and 100%; the percentages require the \'%\' character. The \'a\' value, if
-- specified, can only be a floating point value between 0.0 and 1.0.
-- 
-- In the @/hls()/@ and @/hlsa()/@ formats, the \'h\' value (hue) is an angle between
-- 0 and 360.0 degrees; the \'l\' and \'s\' values (luminance and saturation) are
-- percentage values in the range between 0% and 100%. The \'a\' value, if specified,
-- can only be a floating point value between 0.0 and 1.0.
-- 
-- Whitespace inside the definitions is ignored; no leading whitespace
-- is allowed.
-- 
-- If the alpha component is not specified then it is assumed to be set to
-- be fully opaque.
-- 
-- /Since: 1.0/
colorFromString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@str@/: a string specifiying a color
    -> m ((Bool, Color))
    -- ^ __Returns:__ 'P.True' if parsing succeeded, and 'P.False' otherwise
colorFromString :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m (Bool, Color)
colorFromString Text
str = IO (Bool, Color) -> m (Bool, Color)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Color) -> m (Bool, Color))
-> IO (Bool, Color) -> m (Bool, Color)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Color
color <- Int -> IO (Ptr Color)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
4 :: IO (Ptr Color)
    CString
str' <- Text -> IO CString
textToCString Text
str
    CInt
result <- Ptr Color -> CString -> IO CInt
clutter_color_from_string Ptr Color
color CString
str'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Color
color' <- ((ManagedPtr Color -> Color) -> Ptr Color -> IO Color
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Color -> Color
Color) Ptr Color
color
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
str'
    (Bool, Color) -> IO (Bool, Color)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Color
color')

#if defined(ENABLE_OVERLOADING)
#endif

-- method Color::get_static
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "color"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "StaticColor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the named global color"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Clutter" , name = "Color" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_color_get_static" clutter_color_get_static :: 
    CUInt ->                                -- color : TInterface (Name {namespace = "Clutter", name = "StaticColor"})
    IO (Ptr Color)

-- | Retrieves a static color for the given /@color@/ name
-- 
-- Static colors are created by Clutter and are guaranteed to always be
-- available and valid
-- 
-- /Since: 1.6/
colorGetStatic ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Clutter.Enums.StaticColor
    -- ^ /@color@/: the named global color
    -> m Color
    -- ^ __Returns:__ a pointer to a static color; the returned pointer
    --   is owned by Clutter and it should never be modified or freed
colorGetStatic :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
StaticColor -> m Color
colorGetStatic StaticColor
color = IO Color -> m Color
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Color -> m Color) -> IO Color -> m Color
forall a b. (a -> b) -> a -> b
$ do
    let color' :: CUInt
color' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (StaticColor -> Int) -> StaticColor -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaticColor -> Int
forall a. Enum a => a -> Int
fromEnum) StaticColor
color
    Ptr Color
result <- CUInt -> IO (Ptr Color)
clutter_color_get_static CUInt
color'
    Text -> Ptr Color -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"colorGetStatic" Ptr Color
result
    Color
result' <- ((ManagedPtr Color -> Color) -> Ptr Color -> IO Color
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Color -> Color
Color) Ptr Color
result
    Color -> IO Color
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Color
result'

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveColorMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveColorMethod "add" o = ColorAddMethodInfo
    ResolveColorMethod "copy" o = ColorCopyMethodInfo
    ResolveColorMethod "darken" o = ColorDarkenMethodInfo
    ResolveColorMethod "equal" o = ColorEqualMethodInfo
    ResolveColorMethod "free" o = ColorFreeMethodInfo
    ResolveColorMethod "hash" o = ColorHashMethodInfo
    ResolveColorMethod "init" o = ColorInitMethodInfo
    ResolveColorMethod "interpolate" o = ColorInterpolateMethodInfo
    ResolveColorMethod "lighten" o = ColorLightenMethodInfo
    ResolveColorMethod "shade" o = ColorShadeMethodInfo
    ResolveColorMethod "subtract" o = ColorSubtractMethodInfo
    ResolveColorMethod "toHls" o = ColorToHlsMethodInfo
    ResolveColorMethod "toPixel" o = ColorToPixelMethodInfo
    ResolveColorMethod "toString" o = ColorToStringMethodInfo
    ResolveColorMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif