{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A structure for holding a color definition. The contents of
-- the CoglColor structure are private and should never by accessed
-- directly.
-- 
-- /Since: 1.0/

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

module GI.Cogl.Structs.Color
    ( 

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


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [copy]("GI.Cogl.Structs.Color#g:method:copy"), [free]("GI.Cogl.Structs.Color#g:method:free"), [initFrom4f]("GI.Cogl.Structs.Color#g:method:initFrom4f"), [initFrom4fv]("GI.Cogl.Structs.Color#g:method:initFrom4fv"), [initFrom4ub]("GI.Cogl.Structs.Color#g:method:initFrom4ub"), [premultiply]("GI.Cogl.Structs.Color#g:method:premultiply"), [toHsl]("GI.Cogl.Structs.Color#g:method:toHsl"), [unpremultiply]("GI.Cogl.Structs.Color#g:method:unpremultiply").
-- 
-- ==== Getters
-- [getAlpha]("GI.Cogl.Structs.Color#g:method:getAlpha"), [getAlphaByte]("GI.Cogl.Structs.Color#g:method:getAlphaByte"), [getAlphaFloat]("GI.Cogl.Structs.Color#g:method:getAlphaFloat"), [getBlue]("GI.Cogl.Structs.Color#g:method:getBlue"), [getBlueByte]("GI.Cogl.Structs.Color#g:method:getBlueByte"), [getBlueFloat]("GI.Cogl.Structs.Color#g:method:getBlueFloat"), [getGreen]("GI.Cogl.Structs.Color#g:method:getGreen"), [getGreenByte]("GI.Cogl.Structs.Color#g:method:getGreenByte"), [getGreenFloat]("GI.Cogl.Structs.Color#g:method:getGreenFloat"), [getRed]("GI.Cogl.Structs.Color#g:method:getRed"), [getRedByte]("GI.Cogl.Structs.Color#g:method:getRedByte"), [getRedFloat]("GI.Cogl.Structs.Color#g:method:getRedFloat").
-- 
-- ==== Setters
-- [setAlpha]("GI.Cogl.Structs.Color#g:method:setAlpha"), [setAlphaByte]("GI.Cogl.Structs.Color#g:method:setAlphaByte"), [setAlphaFloat]("GI.Cogl.Structs.Color#g:method:setAlphaFloat"), [setBlue]("GI.Cogl.Structs.Color#g:method:setBlue"), [setBlueByte]("GI.Cogl.Structs.Color#g:method:setBlueByte"), [setBlueFloat]("GI.Cogl.Structs.Color#g:method:setBlueFloat"), [setFrom4f]("GI.Cogl.Structs.Color#g:method:setFrom4f"), [setFrom4ub]("GI.Cogl.Structs.Color#g:method:setFrom4ub"), [setGreen]("GI.Cogl.Structs.Color#g:method:setGreen"), [setGreenByte]("GI.Cogl.Structs.Color#g:method:setGreenByte"), [setGreenFloat]("GI.Cogl.Structs.Color#g:method:setGreenFloat"), [setRed]("GI.Cogl.Structs.Color#g:method:setRed"), [setRedByte]("GI.Cogl.Structs.Color#g:method:setRedByte"), [setRedFloat]("GI.Cogl.Structs.Color#g:method:setRedFloat").

#if defined(ENABLE_OVERLOADING)
    ResolveColorMethod                      ,
#endif

-- ** copy #method:copy#

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


-- ** equal #method:equal#

    colorEqual                              ,


-- ** free #method:free#

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


-- ** getAlpha #method:getAlpha#

#if defined(ENABLE_OVERLOADING)
    ColorGetAlphaMethodInfo                 ,
#endif
    colorGetAlpha                           ,


-- ** getAlphaByte #method:getAlphaByte#

#if defined(ENABLE_OVERLOADING)
    ColorGetAlphaByteMethodInfo             ,
#endif
    colorGetAlphaByte                       ,


-- ** getAlphaFloat #method:getAlphaFloat#

#if defined(ENABLE_OVERLOADING)
    ColorGetAlphaFloatMethodInfo            ,
#endif
    colorGetAlphaFloat                      ,


-- ** getBlue #method:getBlue#

#if defined(ENABLE_OVERLOADING)
    ColorGetBlueMethodInfo                  ,
#endif
    colorGetBlue                            ,


-- ** getBlueByte #method:getBlueByte#

#if defined(ENABLE_OVERLOADING)
    ColorGetBlueByteMethodInfo              ,
#endif
    colorGetBlueByte                        ,


-- ** getBlueFloat #method:getBlueFloat#

#if defined(ENABLE_OVERLOADING)
    ColorGetBlueFloatMethodInfo             ,
#endif
    colorGetBlueFloat                       ,


-- ** getGreen #method:getGreen#

#if defined(ENABLE_OVERLOADING)
    ColorGetGreenMethodInfo                 ,
#endif
    colorGetGreen                           ,


-- ** getGreenByte #method:getGreenByte#

#if defined(ENABLE_OVERLOADING)
    ColorGetGreenByteMethodInfo             ,
#endif
    colorGetGreenByte                       ,


-- ** getGreenFloat #method:getGreenFloat#

#if defined(ENABLE_OVERLOADING)
    ColorGetGreenFloatMethodInfo            ,
#endif
    colorGetGreenFloat                      ,


-- ** getRed #method:getRed#

#if defined(ENABLE_OVERLOADING)
    ColorGetRedMethodInfo                   ,
#endif
    colorGetRed                             ,


-- ** getRedByte #method:getRedByte#

#if defined(ENABLE_OVERLOADING)
    ColorGetRedByteMethodInfo               ,
#endif
    colorGetRedByte                         ,


-- ** getRedFloat #method:getRedFloat#

#if defined(ENABLE_OVERLOADING)
    ColorGetRedFloatMethodInfo              ,
#endif
    colorGetRedFloat                        ,


-- ** initFrom4f #method:initFrom4f#

#if defined(ENABLE_OVERLOADING)
    ColorInitFrom4fMethodInfo               ,
#endif
    colorInitFrom4f                         ,


-- ** initFrom4fv #method:initFrom4fv#

#if defined(ENABLE_OVERLOADING)
    ColorInitFrom4fvMethodInfo              ,
#endif
    colorInitFrom4fv                        ,


-- ** initFrom4ub #method:initFrom4ub#

#if defined(ENABLE_OVERLOADING)
    ColorInitFrom4ubMethodInfo              ,
#endif
    colorInitFrom4ub                        ,


-- ** initFromHsl #method:initFromHsl#

    colorInitFromHsl                        ,


-- ** new #method:new#

    colorNew                                ,


-- ** premultiply #method:premultiply#

#if defined(ENABLE_OVERLOADING)
    ColorPremultiplyMethodInfo              ,
#endif
    colorPremultiply                        ,


-- ** setAlpha #method:setAlpha#

#if defined(ENABLE_OVERLOADING)
    ColorSetAlphaMethodInfo                 ,
#endif
    colorSetAlpha                           ,


-- ** setAlphaByte #method:setAlphaByte#

#if defined(ENABLE_OVERLOADING)
    ColorSetAlphaByteMethodInfo             ,
#endif
    colorSetAlphaByte                       ,


-- ** setAlphaFloat #method:setAlphaFloat#

#if defined(ENABLE_OVERLOADING)
    ColorSetAlphaFloatMethodInfo            ,
#endif
    colorSetAlphaFloat                      ,


-- ** setBlue #method:setBlue#

#if defined(ENABLE_OVERLOADING)
    ColorSetBlueMethodInfo                  ,
#endif
    colorSetBlue                            ,


-- ** setBlueByte #method:setBlueByte#

#if defined(ENABLE_OVERLOADING)
    ColorSetBlueByteMethodInfo              ,
#endif
    colorSetBlueByte                        ,


-- ** setBlueFloat #method:setBlueFloat#

#if defined(ENABLE_OVERLOADING)
    ColorSetBlueFloatMethodInfo             ,
#endif
    colorSetBlueFloat                       ,


-- ** setFrom4f #method:setFrom4f#

#if defined(ENABLE_OVERLOADING)
    ColorSetFrom4fMethodInfo                ,
#endif
    colorSetFrom4f                          ,


-- ** setFrom4ub #method:setFrom4ub#

#if defined(ENABLE_OVERLOADING)
    ColorSetFrom4ubMethodInfo               ,
#endif
    colorSetFrom4ub                         ,


-- ** setGreen #method:setGreen#

#if defined(ENABLE_OVERLOADING)
    ColorSetGreenMethodInfo                 ,
#endif
    colorSetGreen                           ,


-- ** setGreenByte #method:setGreenByte#

#if defined(ENABLE_OVERLOADING)
    ColorSetGreenByteMethodInfo             ,
#endif
    colorSetGreenByte                       ,


-- ** setGreenFloat #method:setGreenFloat#

#if defined(ENABLE_OVERLOADING)
    ColorSetGreenFloatMethodInfo            ,
#endif
    colorSetGreenFloat                      ,


-- ** setRed #method:setRed#

#if defined(ENABLE_OVERLOADING)
    ColorSetRedMethodInfo                   ,
#endif
    colorSetRed                             ,


-- ** setRedByte #method:setRedByte#

#if defined(ENABLE_OVERLOADING)
    ColorSetRedByteMethodInfo               ,
#endif
    colorSetRedByte                         ,


-- ** setRedFloat #method:setRedFloat#

#if defined(ENABLE_OVERLOADING)
    ColorSetRedFloatMethodInfo              ,
#endif
    colorSetRedFloat                        ,


-- ** toHsl #method:toHsl#

#if defined(ENABLE_OVERLOADING)
    ColorToHslMethodInfo                    ,
#endif
    colorToHsl                              ,


-- ** unpremultiply #method:unpremultiply#

#if defined(ENABLE_OVERLOADING)
    ColorUnpremultiplyMethodInfo            ,
#endif
    colorUnpremultiply                      ,




    ) where

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

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


-- | 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 "cogl_color_get_gtype" c_cogl_color_get_gtype :: 
    IO GType

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

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

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_cogl_color_get_gtype
    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
16 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



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Color
type instance O.AttributeList Color = ColorAttributeList
type ColorAttributeList = ('[ ] :: [(Symbol, *)])
#endif

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

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

-- | Creates a new (empty) color
-- 
-- /Since: 1.0/
colorNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Color
    -- ^ __Returns:__ a newly-allocated t'GI.Cogl.Structs.Color.Color'. Use 'GI.Cogl.Structs.Color.colorFree'
    --   to free the allocated resources
colorNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Color
colorNew  = 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)
cogl_color_new
    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::copy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "color"
--           , argType = TInterface Name { namespace = "Cogl" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the color to copy" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Cogl" , name = "Color" })
-- throws : False
-- Skip return : False

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

-- | Creates a copy of /@color@/
-- 
-- /Since: 1.0/
colorCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: the color to copy
    -> m Color
    -- ^ __Returns:__ a newly-allocated t'GI.Cogl.Structs.Color.Color'. Use 'GI.Cogl.Structs.Color.colorFree'
    --   to free the allocate resources
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)
cogl_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.Cogl.Structs.Color.colorCopy",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.3/docs/GI-Cogl-Structs-Color.html#v:colorCopy"
        })


#endif

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

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

-- | Frees the resources allocated by 'GI.Cogl.Structs.Color.colorNew' and 'GI.Cogl.Structs.Color.colorCopy'
-- 
-- /Since: 1.0/
colorFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: the color to free
    -> 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 ()
cogl_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.Cogl.Structs.Color.colorFree",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.3/docs/GI-Cogl-Structs-Color.html#v:colorFree"
        })


#endif

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

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

-- | Retrieves the alpha channel of /@color@/ as a fixed point
-- value between 0 and 1.0.
-- 
-- /Since: 1.0/
colorGetAlpha ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: a t'GI.Cogl.Structs.Color.Color'
    -> m Float
    -- ^ __Returns:__ the alpha channel of the passed color
colorGetAlpha :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Color -> m Float
colorGetAlpha Color
color = IO Float -> m Float
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ do
    Ptr Color
color' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
color
    CFloat
result <- Ptr Color -> IO CFloat
cogl_color_get_alpha Ptr Color
color'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
color
    Float -> IO Float
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

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

instance O.OverloadedMethodInfo ColorGetAlphaMethodInfo Color where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Color.colorGetAlpha",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.3/docs/GI-Cogl-Structs-Color.html#v:colorGetAlpha"
        })


#endif

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

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

-- | Retrieves the alpha channel of /@color@/ as a byte value
-- between 0 and 255
-- 
-- /Since: 1.0/
colorGetAlphaByte ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: a t'GI.Cogl.Structs.Color.Color'
    -> m Word8
    -- ^ __Returns:__ the alpha channel of the passed color
colorGetAlphaByte :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Color -> m Word8
colorGetAlphaByte Color
color = 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
$ do
    Ptr Color
color' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
color
    Word8
result <- Ptr Color -> IO Word8
cogl_color_get_alpha_byte Ptr Color
color'
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
color
    Word8 -> IO Word8
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
result

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

instance O.OverloadedMethodInfo ColorGetAlphaByteMethodInfo Color where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Color.colorGetAlphaByte",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.3/docs/GI-Cogl-Structs-Color.html#v:colorGetAlphaByte"
        })


#endif

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

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

-- | Retrieves the alpha channel of /@color@/ as a floating point
-- value between 0.0 and 1.0
-- 
-- /Since: 1.0/
colorGetAlphaFloat ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: a t'GI.Cogl.Structs.Color.Color'
    -> m Float
    -- ^ __Returns:__ the alpha channel of the passed color
colorGetAlphaFloat :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Color -> m Float
colorGetAlphaFloat Color
color = IO Float -> m Float
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ do
    Ptr Color
color' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
color
    CFloat
result <- Ptr Color -> IO CFloat
cogl_color_get_alpha_float Ptr Color
color'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
color
    Float -> IO Float
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

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

instance O.OverloadedMethodInfo ColorGetAlphaFloatMethodInfo Color where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Color.colorGetAlphaFloat",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.3/docs/GI-Cogl-Structs-Color.html#v:colorGetAlphaFloat"
        })


#endif

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

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

-- | Retrieves the blue channel of /@color@/ as a fixed point
-- value between 0 and 1.0.
-- 
-- /Since: 1.0/
colorGetBlue ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: a t'GI.Cogl.Structs.Color.Color'
    -> m Float
    -- ^ __Returns:__ the blue channel of the passed color
colorGetBlue :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Color -> m Float
colorGetBlue Color
color = IO Float -> m Float
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ do
    Ptr Color
color' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
color
    CFloat
result <- Ptr Color -> IO CFloat
cogl_color_get_blue Ptr Color
color'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
color
    Float -> IO Float
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

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

instance O.OverloadedMethodInfo ColorGetBlueMethodInfo Color where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Color.colorGetBlue",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.3/docs/GI-Cogl-Structs-Color.html#v:colorGetBlue"
        })


#endif

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

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

-- | Retrieves the blue channel of /@color@/ as a byte value
-- between 0 and 255
-- 
-- /Since: 1.0/
colorGetBlueByte ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: a t'GI.Cogl.Structs.Color.Color'
    -> m Word8
    -- ^ __Returns:__ the blue channel of the passed color
colorGetBlueByte :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Color -> m Word8
colorGetBlueByte Color
color = 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
$ do
    Ptr Color
color' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
color
    Word8
result <- Ptr Color -> IO Word8
cogl_color_get_blue_byte Ptr Color
color'
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
color
    Word8 -> IO Word8
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
result

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

instance O.OverloadedMethodInfo ColorGetBlueByteMethodInfo Color where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Color.colorGetBlueByte",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.3/docs/GI-Cogl-Structs-Color.html#v:colorGetBlueByte"
        })


#endif

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

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

-- | Retrieves the blue channel of /@color@/ as a floating point
-- value between 0.0 and 1.0
-- 
-- /Since: 1.0/
colorGetBlueFloat ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: a t'GI.Cogl.Structs.Color.Color'
    -> m Float
    -- ^ __Returns:__ the blue channel of the passed color
colorGetBlueFloat :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Color -> m Float
colorGetBlueFloat Color
color = IO Float -> m Float
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ do
    Ptr Color
color' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
color
    CFloat
result <- Ptr Color -> IO CFloat
cogl_color_get_blue_float Ptr Color
color'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
color
    Float -> IO Float
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

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

instance O.OverloadedMethodInfo ColorGetBlueFloatMethodInfo Color where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Color.colorGetBlueFloat",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.3/docs/GI-Cogl-Structs-Color.html#v:colorGetBlueFloat"
        })


#endif

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

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

-- | Retrieves the green channel of /@color@/ as a fixed point
-- value between 0 and 1.0.
-- 
-- /Since: 1.0/
colorGetGreen ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: a t'GI.Cogl.Structs.Color.Color'
    -> m Float
    -- ^ __Returns:__ the green channel of the passed color
colorGetGreen :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Color -> m Float
colorGetGreen Color
color = IO Float -> m Float
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ do
    Ptr Color
color' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
color
    CFloat
result <- Ptr Color -> IO CFloat
cogl_color_get_green Ptr Color
color'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
color
    Float -> IO Float
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

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

instance O.OverloadedMethodInfo ColorGetGreenMethodInfo Color where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Color.colorGetGreen",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.3/docs/GI-Cogl-Structs-Color.html#v:colorGetGreen"
        })


#endif

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

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

-- | Retrieves the green channel of /@color@/ as a byte value
-- between 0 and 255
-- 
-- /Since: 1.0/
colorGetGreenByte ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: a t'GI.Cogl.Structs.Color.Color'
    -> m Word8
    -- ^ __Returns:__ the green channel of the passed color
colorGetGreenByte :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Color -> m Word8
colorGetGreenByte Color
color = 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
$ do
    Ptr Color
color' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
color
    Word8
result <- Ptr Color -> IO Word8
cogl_color_get_green_byte Ptr Color
color'
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
color
    Word8 -> IO Word8
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
result

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

instance O.OverloadedMethodInfo ColorGetGreenByteMethodInfo Color where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Color.colorGetGreenByte",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.3/docs/GI-Cogl-Structs-Color.html#v:colorGetGreenByte"
        })


#endif

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

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

-- | Retrieves the green channel of /@color@/ as a floating point
-- value between 0.0 and 1.0
-- 
-- /Since: 1.0/
colorGetGreenFloat ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: a t'GI.Cogl.Structs.Color.Color'
    -> m Float
    -- ^ __Returns:__ the green channel of the passed color
colorGetGreenFloat :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Color -> m Float
colorGetGreenFloat Color
color = IO Float -> m Float
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ do
    Ptr Color
color' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
color
    CFloat
result <- Ptr Color -> IO CFloat
cogl_color_get_green_float Ptr Color
color'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
color
    Float -> IO Float
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

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

instance O.OverloadedMethodInfo ColorGetGreenFloatMethodInfo Color where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Color.colorGetGreenFloat",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.3/docs/GI-Cogl-Structs-Color.html#v:colorGetGreenFloat"
        })


#endif

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

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

-- | Retrieves the red channel of /@color@/ as a fixed point
-- value between 0 and 1.0.
-- 
-- /Since: 1.0/
colorGetRed ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: a t'GI.Cogl.Structs.Color.Color'
    -> m Float
    -- ^ __Returns:__ the red channel of the passed color
colorGetRed :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Color -> m Float
colorGetRed Color
color = IO Float -> m Float
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ do
    Ptr Color
color' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
color
    CFloat
result <- Ptr Color -> IO CFloat
cogl_color_get_red Ptr Color
color'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
color
    Float -> IO Float
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

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

instance O.OverloadedMethodInfo ColorGetRedMethodInfo Color where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Color.colorGetRed",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.3/docs/GI-Cogl-Structs-Color.html#v:colorGetRed"
        })


#endif

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

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

-- | Retrieves the red channel of /@color@/ as a byte value
-- between 0 and 255
-- 
-- /Since: 1.0/
colorGetRedByte ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: a t'GI.Cogl.Structs.Color.Color'
    -> m Word8
    -- ^ __Returns:__ the red channel of the passed color
colorGetRedByte :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Color -> m Word8
colorGetRedByte Color
color = 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
$ do
    Ptr Color
color' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
color
    Word8
result <- Ptr Color -> IO Word8
cogl_color_get_red_byte Ptr Color
color'
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
color
    Word8 -> IO Word8
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
result

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

instance O.OverloadedMethodInfo ColorGetRedByteMethodInfo Color where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Color.colorGetRedByte",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.3/docs/GI-Cogl-Structs-Color.html#v:colorGetRedByte"
        })


#endif

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

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

-- | Retrieves the red channel of /@color@/ as a floating point
-- value between 0.0 and 1.0
-- 
-- /Since: 1.0/
colorGetRedFloat ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: a t'GI.Cogl.Structs.Color.Color'
    -> m Float
    -- ^ __Returns:__ the red channel of the passed color
colorGetRedFloat :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Color -> m Float
colorGetRedFloat Color
color = IO Float -> m Float
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ do
    Ptr Color
color' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
color
    CFloat
result <- Ptr Color -> IO CFloat
cogl_color_get_red_float Ptr Color
color'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
color
    Float -> IO Float
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

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

instance O.OverloadedMethodInfo ColorGetRedFloatMethodInfo Color where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Color.colorGetRedFloat",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.3/docs/GI-Cogl-Structs-Color.html#v:colorGetRedFloat"
        })


#endif

-- method Color::init_from_4f
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "color"
--           , argType = TInterface Name { namespace = "Cogl" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A pointer to a #CoglColor to initialize"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "red"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "value of the red channel, between 0 and 1.0"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "green"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "value of the green channel, between 0 and 1.0"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "blue"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "value of the blue channel, between 0 and 1.0"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "alpha"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "value of the alpha channel, between 0 and 1.0"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_color_init_from_4f" cogl_color_init_from_4f :: 
    Ptr Color ->                            -- color : TInterface (Name {namespace = "Cogl", name = "Color"})
    CFloat ->                               -- red : TBasicType TFloat
    CFloat ->                               -- green : TBasicType TFloat
    CFloat ->                               -- blue : TBasicType TFloat
    CFloat ->                               -- alpha : TBasicType TFloat
    IO ()

-- | Sets the values of the passed channels into a t'GI.Cogl.Structs.Color.Color'
-- 
-- /Since: 1.4/
colorInitFrom4f ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: A pointer to a t'GI.Cogl.Structs.Color.Color' to initialize
    -> Float
    -- ^ /@red@/: value of the red channel, between 0 and 1.0
    -> Float
    -- ^ /@green@/: value of the green channel, between 0 and 1.0
    -> Float
    -- ^ /@blue@/: value of the blue channel, between 0 and 1.0
    -> Float
    -- ^ /@alpha@/: value of the alpha channel, between 0 and 1.0
    -> m ()
colorInitFrom4f :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Color -> Float -> Float -> Float -> Float -> m ()
colorInitFrom4f Color
color Float
red Float
green Float
blue Float
alpha = 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
    let red' :: CFloat
red' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
red
    let green' :: CFloat
green' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
green
    let blue' :: CFloat
blue' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
blue
    let alpha' :: CFloat
alpha' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
alpha
    Ptr Color -> CFloat -> CFloat -> CFloat -> CFloat -> IO ()
cogl_color_init_from_4f Ptr Color
color' CFloat
red' CFloat
green' CFloat
blue' CFloat
alpha'
    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 ColorInitFrom4fMethodInfo
instance (signature ~ (Float -> Float -> Float -> Float -> m ()), MonadIO m) => O.OverloadedMethod ColorInitFrom4fMethodInfo Color signature where
    overloadedMethod = colorInitFrom4f

instance O.OverloadedMethodInfo ColorInitFrom4fMethodInfo Color where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Color.colorInitFrom4f",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.3/docs/GI-Cogl-Structs-Color.html#v:colorInitFrom4f"
        })


#endif

-- method Color::init_from_4fv
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "color"
--           , argType = TInterface Name { namespace = "Cogl" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A pointer to a #CoglColor to initialize"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "color_array"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a pointer to an array of 4 float color components"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_color_init_from_4fv" cogl_color_init_from_4fv :: 
    Ptr Color ->                            -- color : TInterface (Name {namespace = "Cogl", name = "Color"})
    CFloat ->                               -- color_array : TBasicType TFloat
    IO ()

-- | Sets the values of the passed channels into a t'GI.Cogl.Structs.Color.Color'
-- 
-- /Since: 1.4/
colorInitFrom4fv ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: A pointer to a t'GI.Cogl.Structs.Color.Color' to initialize
    -> Float
    -- ^ /@colorArray@/: a pointer to an array of 4 float color components
    -> m ()
colorInitFrom4fv :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Color -> Float -> m ()
colorInitFrom4fv Color
color Float
colorArray = 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
    let colorArray' :: CFloat
colorArray' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
colorArray
    Ptr Color -> CFloat -> IO ()
cogl_color_init_from_4fv Ptr Color
color' CFloat
colorArray'
    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 ColorInitFrom4fvMethodInfo
instance (signature ~ (Float -> m ()), MonadIO m) => O.OverloadedMethod ColorInitFrom4fvMethodInfo Color signature where
    overloadedMethod = colorInitFrom4fv

instance O.OverloadedMethodInfo ColorInitFrom4fvMethodInfo Color where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Color.colorInitFrom4fv",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.3/docs/GI-Cogl-Structs-Color.html#v:colorInitFrom4fv"
        })


#endif

-- method Color::init_from_4ub
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "color"
--           , argType = TInterface Name { namespace = "Cogl" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A pointer to a #CoglColor to initialize"
--                 , 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 "value of the red channel, 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 "value of the green channel, 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 "value of the blue channel, 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 "value of the alpha channel, between 0 and 255"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Sets the values of the passed channels into a t'GI.Cogl.Structs.Color.Color'.
-- 
-- /Since: 1.4/
colorInitFrom4ub ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: A pointer to a t'GI.Cogl.Structs.Color.Color' to initialize
    -> Word8
    -- ^ /@red@/: value of the red channel, between 0 and 255
    -> Word8
    -- ^ /@green@/: value of the green channel, between 0 and 255
    -> Word8
    -- ^ /@blue@/: value of the blue channel, between 0 and 255
    -> Word8
    -- ^ /@alpha@/: value of the alpha channel, between 0 and 255
    -> m ()
colorInitFrom4ub :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Color -> Word8 -> Word8 -> Word8 -> Word8 -> m ()
colorInitFrom4ub Color
color Word8
red Word8
green Word8
blue Word8
alpha = 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 -> Word8 -> Word8 -> Word8 -> Word8 -> IO ()
cogl_color_init_from_4ub Ptr Color
color' Word8
red Word8
green Word8
blue Word8
alpha
    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 ColorInitFrom4ubMethodInfo
instance (signature ~ (Word8 -> Word8 -> Word8 -> Word8 -> m ()), MonadIO m) => O.OverloadedMethod ColorInitFrom4ubMethodInfo Color signature where
    overloadedMethod = colorInitFrom4ub

instance O.OverloadedMethodInfo ColorInitFrom4ubMethodInfo Color where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Color.colorInitFrom4ub",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.3/docs/GI-Cogl-Structs-Color.html#v:colorInitFrom4ub"
        })


#endif

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

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

-- | Converts a non-premultiplied color to a pre-multiplied color. For
-- example, semi-transparent red is (1.0, 0, 0, 0.5) when non-premultiplied
-- and (0.5, 0, 0, 0.5) when premultiplied.
-- 
-- /Since: 1.0/
colorPremultiply ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: the color to premultiply
    -> m ()
colorPremultiply :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Color -> m ()
colorPremultiply 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 ()
cogl_color_premultiply 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 ColorPremultiplyMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod ColorPremultiplyMethodInfo Color signature where
    overloadedMethod = colorPremultiply

instance O.OverloadedMethodInfo ColorPremultiplyMethodInfo Color where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Color.colorPremultiply",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.3/docs/GI-Cogl-Structs-Color.html#v:colorPremultiply"
        })


#endif

-- method Color::set_alpha
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "color"
--           , argType = TInterface Name { namespace = "Cogl" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #CoglColor" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "alpha"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a float value between 0.0f and 1.0f"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_color_set_alpha" cogl_color_set_alpha :: 
    Ptr Color ->                            -- color : TInterface (Name {namespace = "Cogl", name = "Color"})
    CFloat ->                               -- alpha : TBasicType TFloat
    IO ()

-- | Sets the alpha channel of /@color@/ to /@alpha@/.
-- 
-- /Since: 1.4/
colorSetAlpha ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: a t'GI.Cogl.Structs.Color.Color'
    -> Float
    -- ^ /@alpha@/: a float value between 0.0f and 1.0f
    -> m ()
colorSetAlpha :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Color -> Float -> m ()
colorSetAlpha Color
color Float
alpha = 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
    let alpha' :: CFloat
alpha' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
alpha
    Ptr Color -> CFloat -> IO ()
cogl_color_set_alpha Ptr Color
color' CFloat
alpha'
    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 ColorSetAlphaMethodInfo
instance (signature ~ (Float -> m ()), MonadIO m) => O.OverloadedMethod ColorSetAlphaMethodInfo Color signature where
    overloadedMethod = colorSetAlpha

instance O.OverloadedMethodInfo ColorSetAlphaMethodInfo Color where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Color.colorSetAlpha",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.3/docs/GI-Cogl-Structs-Color.html#v:colorSetAlpha"
        })


#endif

-- method Color::set_alpha_byte
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "color"
--           , argType = TInterface Name { namespace = "Cogl" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #CoglColor" , 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 "a byte value between 0 and 255"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_color_set_alpha_byte" cogl_color_set_alpha_byte :: 
    Ptr Color ->                            -- color : TInterface (Name {namespace = "Cogl", name = "Color"})
    Word8 ->                                -- alpha : TBasicType TUInt8
    IO ()

-- | Sets the alpha channel of /@color@/ to /@alpha@/.
-- 
-- /Since: 1.4/
colorSetAlphaByte ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: a t'GI.Cogl.Structs.Color.Color'
    -> Word8
    -- ^ /@alpha@/: a byte value between 0 and 255
    -> m ()
colorSetAlphaByte :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Color -> Word8 -> m ()
colorSetAlphaByte Color
color Word8
alpha = 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 -> Word8 -> IO ()
cogl_color_set_alpha_byte Ptr Color
color' Word8
alpha
    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 ColorSetAlphaByteMethodInfo
instance (signature ~ (Word8 -> m ()), MonadIO m) => O.OverloadedMethod ColorSetAlphaByteMethodInfo Color signature where
    overloadedMethod = colorSetAlphaByte

instance O.OverloadedMethodInfo ColorSetAlphaByteMethodInfo Color where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Color.colorSetAlphaByte",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.3/docs/GI-Cogl-Structs-Color.html#v:colorSetAlphaByte"
        })


#endif

-- method Color::set_alpha_float
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "color"
--           , argType = TInterface Name { namespace = "Cogl" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #CoglColor" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "alpha"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a float value between 0.0f and 1.0f"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_color_set_alpha_float" cogl_color_set_alpha_float :: 
    Ptr Color ->                            -- color : TInterface (Name {namespace = "Cogl", name = "Color"})
    CFloat ->                               -- alpha : TBasicType TFloat
    IO ()

-- | Sets the alpha channel of /@color@/ to /@alpha@/.
-- 
-- /Since: 1.4/
colorSetAlphaFloat ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: a t'GI.Cogl.Structs.Color.Color'
    -> Float
    -- ^ /@alpha@/: a float value between 0.0f and 1.0f
    -> m ()
colorSetAlphaFloat :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Color -> Float -> m ()
colorSetAlphaFloat Color
color Float
alpha = 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
    let alpha' :: CFloat
alpha' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
alpha
    Ptr Color -> CFloat -> IO ()
cogl_color_set_alpha_float Ptr Color
color' CFloat
alpha'
    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 ColorSetAlphaFloatMethodInfo
instance (signature ~ (Float -> m ()), MonadIO m) => O.OverloadedMethod ColorSetAlphaFloatMethodInfo Color signature where
    overloadedMethod = colorSetAlphaFloat

instance O.OverloadedMethodInfo ColorSetAlphaFloatMethodInfo Color where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Color.colorSetAlphaFloat",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.3/docs/GI-Cogl-Structs-Color.html#v:colorSetAlphaFloat"
        })


#endif

-- method Color::set_blue
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "color"
--           , argType = TInterface Name { namespace = "Cogl" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #CoglColor" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "blue"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a float value between 0.0f and 1.0f"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_color_set_blue" cogl_color_set_blue :: 
    Ptr Color ->                            -- color : TInterface (Name {namespace = "Cogl", name = "Color"})
    CFloat ->                               -- blue : TBasicType TFloat
    IO ()

-- | Sets the blue channel of /@color@/ to /@blue@/.
-- 
-- /Since: 1.4/
colorSetBlue ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: a t'GI.Cogl.Structs.Color.Color'
    -> Float
    -- ^ /@blue@/: a float value between 0.0f and 1.0f
    -> m ()
colorSetBlue :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Color -> Float -> m ()
colorSetBlue Color
color Float
blue = 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
    let blue' :: CFloat
blue' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
blue
    Ptr Color -> CFloat -> IO ()
cogl_color_set_blue Ptr Color
color' CFloat
blue'
    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 ColorSetBlueMethodInfo
instance (signature ~ (Float -> m ()), MonadIO m) => O.OverloadedMethod ColorSetBlueMethodInfo Color signature where
    overloadedMethod = colorSetBlue

instance O.OverloadedMethodInfo ColorSetBlueMethodInfo Color where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Color.colorSetBlue",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.3/docs/GI-Cogl-Structs-Color.html#v:colorSetBlue"
        })


#endif

-- method Color::set_blue_byte
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "color"
--           , argType = TInterface Name { namespace = "Cogl" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #CoglColor" , 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 "a byte value between 0 and 255"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_color_set_blue_byte" cogl_color_set_blue_byte :: 
    Ptr Color ->                            -- color : TInterface (Name {namespace = "Cogl", name = "Color"})
    Word8 ->                                -- blue : TBasicType TUInt8
    IO ()

-- | Sets the blue channel of /@color@/ to /@blue@/.
-- 
-- /Since: 1.4/
colorSetBlueByte ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: a t'GI.Cogl.Structs.Color.Color'
    -> Word8
    -- ^ /@blue@/: a byte value between 0 and 255
    -> m ()
colorSetBlueByte :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Color -> Word8 -> m ()
colorSetBlueByte Color
color Word8
blue = 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 -> Word8 -> IO ()
cogl_color_set_blue_byte Ptr Color
color' Word8
blue
    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 ColorSetBlueByteMethodInfo
instance (signature ~ (Word8 -> m ()), MonadIO m) => O.OverloadedMethod ColorSetBlueByteMethodInfo Color signature where
    overloadedMethod = colorSetBlueByte

instance O.OverloadedMethodInfo ColorSetBlueByteMethodInfo Color where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Color.colorSetBlueByte",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.3/docs/GI-Cogl-Structs-Color.html#v:colorSetBlueByte"
        })


#endif

-- method Color::set_blue_float
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "color"
--           , argType = TInterface Name { namespace = "Cogl" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #CoglColor" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "blue"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a float value between 0.0f and 1.0f"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_color_set_blue_float" cogl_color_set_blue_float :: 
    Ptr Color ->                            -- color : TInterface (Name {namespace = "Cogl", name = "Color"})
    CFloat ->                               -- blue : TBasicType TFloat
    IO ()

-- | Sets the blue channel of /@color@/ to /@blue@/.
-- 
-- /Since: 1.4/
colorSetBlueFloat ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: a t'GI.Cogl.Structs.Color.Color'
    -> Float
    -- ^ /@blue@/: a float value between 0.0f and 1.0f
    -> m ()
colorSetBlueFloat :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Color -> Float -> m ()
colorSetBlueFloat Color
color Float
blue = 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
    let blue' :: CFloat
blue' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
blue
    Ptr Color -> CFloat -> IO ()
cogl_color_set_blue_float Ptr Color
color' CFloat
blue'
    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 ColorSetBlueFloatMethodInfo
instance (signature ~ (Float -> m ()), MonadIO m) => O.OverloadedMethod ColorSetBlueFloatMethodInfo Color signature where
    overloadedMethod = colorSetBlueFloat

instance O.OverloadedMethodInfo ColorSetBlueFloatMethodInfo Color where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Color.colorSetBlueFloat",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.3/docs/GI-Cogl-Structs-Color.html#v:colorSetBlueFloat"
        })


#endif

-- method Color::set_from_4f
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "color"
--           , argType = TInterface Name { namespace = "Cogl" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A pointer to a #CoglColor to initialize"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "red"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "value of the red channel, between 0 and %1.0"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "green"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "value of the green channel, between 0 and %1.0"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "blue"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "value of the blue channel, between 0 and %1.0"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "alpha"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "value of the alpha channel, between 0 and %1.0"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_color_set_from_4f" cogl_color_set_from_4f :: 
    Ptr Color ->                            -- color : TInterface (Name {namespace = "Cogl", name = "Color"})
    CFloat ->                               -- red : TBasicType TFloat
    CFloat ->                               -- green : TBasicType TFloat
    CFloat ->                               -- blue : TBasicType TFloat
    CFloat ->                               -- alpha : TBasicType TFloat
    IO ()

{-# DEPRECATED colorSetFrom4f ["(Since version 1.4)","Use cogl_color_init_from_4f instead."] #-}
-- | Sets the values of the passed channels into a t'GI.Cogl.Structs.Color.Color'
-- 
-- /Since: 1.0/
colorSetFrom4f ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: A pointer to a t'GI.Cogl.Structs.Color.Color' to initialize
    -> Float
    -- ^ /@red@/: value of the red channel, between 0 and @/1/@.0
    -> Float
    -- ^ /@green@/: value of the green channel, between 0 and @/1/@.0
    -> Float
    -- ^ /@blue@/: value of the blue channel, between 0 and @/1/@.0
    -> Float
    -- ^ /@alpha@/: value of the alpha channel, between 0 and @/1/@.0
    -> m ()
colorSetFrom4f :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Color -> Float -> Float -> Float -> Float -> m ()
colorSetFrom4f Color
color Float
red Float
green Float
blue Float
alpha = 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
    let red' :: CFloat
red' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
red
    let green' :: CFloat
green' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
green
    let blue' :: CFloat
blue' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
blue
    let alpha' :: CFloat
alpha' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
alpha
    Ptr Color -> CFloat -> CFloat -> CFloat -> CFloat -> IO ()
cogl_color_set_from_4f Ptr Color
color' CFloat
red' CFloat
green' CFloat
blue' CFloat
alpha'
    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 ColorSetFrom4fMethodInfo
instance (signature ~ (Float -> Float -> Float -> Float -> m ()), MonadIO m) => O.OverloadedMethod ColorSetFrom4fMethodInfo Color signature where
    overloadedMethod = colorSetFrom4f

instance O.OverloadedMethodInfo ColorSetFrom4fMethodInfo Color where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Color.colorSetFrom4f",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.3/docs/GI-Cogl-Structs-Color.html#v:colorSetFrom4f"
        })


#endif

-- method Color::set_from_4ub
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "color"
--           , argType = TInterface Name { namespace = "Cogl" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A pointer to a #CoglColor to initialize"
--                 , 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 "value of the red channel, 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 "value of the green channel, 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 "value of the blue channel, 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 "value of the alpha channel, between 0 and 255"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

{-# DEPRECATED colorSetFrom4ub ["(Since version 1.4)","Use cogl_color_init_from_4ub instead."] #-}
-- | Sets the values of the passed channels into a t'GI.Cogl.Structs.Color.Color'.
-- 
-- /Since: 1.0/
colorSetFrom4ub ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: A pointer to a t'GI.Cogl.Structs.Color.Color' to initialize
    -> Word8
    -- ^ /@red@/: value of the red channel, between 0 and 255
    -> Word8
    -- ^ /@green@/: value of the green channel, between 0 and 255
    -> Word8
    -- ^ /@blue@/: value of the blue channel, between 0 and 255
    -> Word8
    -- ^ /@alpha@/: value of the alpha channel, between 0 and 255
    -> m ()
colorSetFrom4ub :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Color -> Word8 -> Word8 -> Word8 -> Word8 -> m ()
colorSetFrom4ub Color
color Word8
red Word8
green Word8
blue Word8
alpha = 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 -> Word8 -> Word8 -> Word8 -> Word8 -> IO ()
cogl_color_set_from_4ub Ptr Color
color' Word8
red Word8
green Word8
blue Word8
alpha
    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 ColorSetFrom4ubMethodInfo
instance (signature ~ (Word8 -> Word8 -> Word8 -> Word8 -> m ()), MonadIO m) => O.OverloadedMethod ColorSetFrom4ubMethodInfo Color signature where
    overloadedMethod = colorSetFrom4ub

instance O.OverloadedMethodInfo ColorSetFrom4ubMethodInfo Color where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Color.colorSetFrom4ub",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.3/docs/GI-Cogl-Structs-Color.html#v:colorSetFrom4ub"
        })


#endif

-- method Color::set_green
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "color"
--           , argType = TInterface Name { namespace = "Cogl" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #CoglColor" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "green"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a float value between 0.0f and 1.0f"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_color_set_green" cogl_color_set_green :: 
    Ptr Color ->                            -- color : TInterface (Name {namespace = "Cogl", name = "Color"})
    CFloat ->                               -- green : TBasicType TFloat
    IO ()

-- | Sets the green channel of /@color@/ to /@green@/.
-- 
-- /Since: 1.4/
colorSetGreen ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: a t'GI.Cogl.Structs.Color.Color'
    -> Float
    -- ^ /@green@/: a float value between 0.0f and 1.0f
    -> m ()
colorSetGreen :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Color -> Float -> m ()
colorSetGreen Color
color Float
green = 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
    let green' :: CFloat
green' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
green
    Ptr Color -> CFloat -> IO ()
cogl_color_set_green Ptr Color
color' CFloat
green'
    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 ColorSetGreenMethodInfo
instance (signature ~ (Float -> m ()), MonadIO m) => O.OverloadedMethod ColorSetGreenMethodInfo Color signature where
    overloadedMethod = colorSetGreen

instance O.OverloadedMethodInfo ColorSetGreenMethodInfo Color where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Color.colorSetGreen",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.3/docs/GI-Cogl-Structs-Color.html#v:colorSetGreen"
        })


#endif

-- method Color::set_green_byte
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "color"
--           , argType = TInterface Name { namespace = "Cogl" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #CoglColor" , 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 "a byte value between 0 and 255"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_color_set_green_byte" cogl_color_set_green_byte :: 
    Ptr Color ->                            -- color : TInterface (Name {namespace = "Cogl", name = "Color"})
    Word8 ->                                -- green : TBasicType TUInt8
    IO ()

-- | Sets the green channel of /@color@/ to /@green@/.
-- 
-- /Since: 1.4/
colorSetGreenByte ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: a t'GI.Cogl.Structs.Color.Color'
    -> Word8
    -- ^ /@green@/: a byte value between 0 and 255
    -> m ()
colorSetGreenByte :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Color -> Word8 -> m ()
colorSetGreenByte Color
color Word8
green = 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 -> Word8 -> IO ()
cogl_color_set_green_byte Ptr Color
color' Word8
green
    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 ColorSetGreenByteMethodInfo
instance (signature ~ (Word8 -> m ()), MonadIO m) => O.OverloadedMethod ColorSetGreenByteMethodInfo Color signature where
    overloadedMethod = colorSetGreenByte

instance O.OverloadedMethodInfo ColorSetGreenByteMethodInfo Color where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Color.colorSetGreenByte",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.3/docs/GI-Cogl-Structs-Color.html#v:colorSetGreenByte"
        })


#endif

-- method Color::set_green_float
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "color"
--           , argType = TInterface Name { namespace = "Cogl" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #CoglColor" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "green"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a float value between 0.0f and 1.0f"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_color_set_green_float" cogl_color_set_green_float :: 
    Ptr Color ->                            -- color : TInterface (Name {namespace = "Cogl", name = "Color"})
    CFloat ->                               -- green : TBasicType TFloat
    IO ()

-- | Sets the green channel of /@color@/ to /@green@/.
-- 
-- /Since: 1.4/
colorSetGreenFloat ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: a t'GI.Cogl.Structs.Color.Color'
    -> Float
    -- ^ /@green@/: a float value between 0.0f and 1.0f
    -> m ()
colorSetGreenFloat :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Color -> Float -> m ()
colorSetGreenFloat Color
color Float
green = 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
    let green' :: CFloat
green' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
green
    Ptr Color -> CFloat -> IO ()
cogl_color_set_green_float Ptr Color
color' CFloat
green'
    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 ColorSetGreenFloatMethodInfo
instance (signature ~ (Float -> m ()), MonadIO m) => O.OverloadedMethod ColorSetGreenFloatMethodInfo Color signature where
    overloadedMethod = colorSetGreenFloat

instance O.OverloadedMethodInfo ColorSetGreenFloatMethodInfo Color where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Color.colorSetGreenFloat",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.3/docs/GI-Cogl-Structs-Color.html#v:colorSetGreenFloat"
        })


#endif

-- method Color::set_red
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "color"
--           , argType = TInterface Name { namespace = "Cogl" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #CoglColor" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "red"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a float value between 0.0f and 1.0f"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_color_set_red" cogl_color_set_red :: 
    Ptr Color ->                            -- color : TInterface (Name {namespace = "Cogl", name = "Color"})
    CFloat ->                               -- red : TBasicType TFloat
    IO ()

-- | Sets the red channel of /@color@/ to /@red@/.
-- 
-- /Since: 1.4/
colorSetRed ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: a t'GI.Cogl.Structs.Color.Color'
    -> Float
    -- ^ /@red@/: a float value between 0.0f and 1.0f
    -> m ()
colorSetRed :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Color -> Float -> m ()
colorSetRed Color
color Float
red = 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
    let red' :: CFloat
red' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
red
    Ptr Color -> CFloat -> IO ()
cogl_color_set_red Ptr Color
color' CFloat
red'
    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 ColorSetRedMethodInfo
instance (signature ~ (Float -> m ()), MonadIO m) => O.OverloadedMethod ColorSetRedMethodInfo Color signature where
    overloadedMethod = colorSetRed

instance O.OverloadedMethodInfo ColorSetRedMethodInfo Color where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Color.colorSetRed",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.3/docs/GI-Cogl-Structs-Color.html#v:colorSetRed"
        })


#endif

-- method Color::set_red_byte
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "color"
--           , argType = TInterface Name { namespace = "Cogl" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #CoglColor" , 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 "a byte value between 0 and 255"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_color_set_red_byte" cogl_color_set_red_byte :: 
    Ptr Color ->                            -- color : TInterface (Name {namespace = "Cogl", name = "Color"})
    Word8 ->                                -- red : TBasicType TUInt8
    IO ()

-- | Sets the red channel of /@color@/ to /@red@/.
-- 
-- /Since: 1.4/
colorSetRedByte ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: a t'GI.Cogl.Structs.Color.Color'
    -> Word8
    -- ^ /@red@/: a byte value between 0 and 255
    -> m ()
colorSetRedByte :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Color -> Word8 -> m ()
colorSetRedByte Color
color Word8
red = 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 -> Word8 -> IO ()
cogl_color_set_red_byte Ptr Color
color' Word8
red
    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 ColorSetRedByteMethodInfo
instance (signature ~ (Word8 -> m ()), MonadIO m) => O.OverloadedMethod ColorSetRedByteMethodInfo Color signature where
    overloadedMethod = colorSetRedByte

instance O.OverloadedMethodInfo ColorSetRedByteMethodInfo Color where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Color.colorSetRedByte",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.3/docs/GI-Cogl-Structs-Color.html#v:colorSetRedByte"
        })


#endif

-- method Color::set_red_float
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "color"
--           , argType = TInterface Name { namespace = "Cogl" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #CoglColor" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "red"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a float value between 0.0f and 1.0f"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_color_set_red_float" cogl_color_set_red_float :: 
    Ptr Color ->                            -- color : TInterface (Name {namespace = "Cogl", name = "Color"})
    CFloat ->                               -- red : TBasicType TFloat
    IO ()

-- | Sets the red channel of /@color@/ to /@red@/.
-- 
-- /Since: 1.4/
colorSetRedFloat ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: a t'GI.Cogl.Structs.Color.Color'
    -> Float
    -- ^ /@red@/: a float value between 0.0f and 1.0f
    -> m ()
colorSetRedFloat :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Color -> Float -> m ()
colorSetRedFloat Color
color Float
red = 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
    let red' :: CFloat
red' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
red
    Ptr Color -> CFloat -> IO ()
cogl_color_set_red_float Ptr Color
color' CFloat
red'
    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 ColorSetRedFloatMethodInfo
instance (signature ~ (Float -> m ()), MonadIO m) => O.OverloadedMethod ColorSetRedFloatMethodInfo Color signature where
    overloadedMethod = colorSetRedFloat

instance O.OverloadedMethodInfo ColorSetRedFloatMethodInfo Color where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Color.colorSetRedFloat",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.3/docs/GI-Cogl-Structs-Color.html#v:colorSetRedFloat"
        })


#endif

-- method Color::to_hsl
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "color"
--           , argType = TInterface Name { namespace = "Cogl" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #CoglColor" , 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 = "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
--           }
--       , 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
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_color_to_hsl" cogl_color_to_hsl :: 
    Ptr Color ->                            -- color : TInterface (Name {namespace = "Cogl", name = "Color"})
    Ptr CFloat ->                           -- hue : TBasicType TFloat
    Ptr CFloat ->                           -- saturation : TBasicType TFloat
    Ptr CFloat ->                           -- luminance : 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.
-- 
-- /Since: 1.16/
colorToHsl ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: a t'GI.Cogl.Structs.Color.Color'
    -> m ((Float, Float, Float))
colorToHsl :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Color -> m (Float, Float, Float)
colorToHsl 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
saturation <- 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 Color -> Ptr CFloat -> Ptr CFloat -> Ptr CFloat -> IO ()
cogl_color_to_hsl Ptr Color
color' Ptr CFloat
hue Ptr CFloat
saturation Ptr CFloat
luminance
    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
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'
    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'
    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
saturation
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
luminance
    (Float, Float, Float) -> IO (Float, Float, Float)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Float
hue'', Float
saturation'', Float
luminance'')

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

instance O.OverloadedMethodInfo ColorToHslMethodInfo Color where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Color.colorToHsl",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.3/docs/GI-Cogl-Structs-Color.html#v:colorToHsl"
        })


#endif

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

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

-- | Converts a pre-multiplied color to a non-premultiplied color. For
-- example, semi-transparent red is (0.5, 0, 0, 0.5) when premultiplied
-- and (1.0, 0, 0, 0.5) when non-premultiplied.
-- 
-- /Since: 1.4/
colorUnpremultiply ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: the color to unpremultiply
    -> m ()
colorUnpremultiply :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Color -> m ()
colorUnpremultiply 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 ()
cogl_color_unpremultiply 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 ColorUnpremultiplyMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod ColorUnpremultiplyMethodInfo Color signature where
    overloadedMethod = colorUnpremultiply

instance O.OverloadedMethodInfo ColorUnpremultiplyMethodInfo Color where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Color.colorUnpremultiply",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.3/docs/GI-Cogl-Structs-Color.html#v:colorUnpremultiply"
        })


#endif

-- method Color::equal
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "v1"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #CoglColor" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "v2"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #CoglColor" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "cogl_color_equal" cogl_color_equal :: 
    Ptr () ->                               -- v1 : TBasicType TPtr
    Ptr () ->                               -- v2 : TBasicType TPtr
    IO Int32

-- | Compares two t'GI.Cogl.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.Cogl.Structs.Color.Color's as keys in a t'GI.GLib.Structs.HashTable.HashTable'.
-- 
-- /Since: 1.0/
colorEqual ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Ptr ()
    -- ^ /@v1@/: a t'GI.Cogl.Structs.Color.Color'
    -> Ptr ()
    -- ^ /@v2@/: a t'GI.Cogl.Structs.Color.Color'
    -> m Int32
    -- ^ __Returns:__ 'P.True' if the two colors are the same.
colorEqual :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Ptr () -> Ptr () -> m Int32
colorEqual Ptr ()
v1 Ptr ()
v2 = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Int32
result <- Ptr () -> Ptr () -> IO Int32
cogl_color_equal Ptr ()
v1 Ptr ()
v2
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
#endif

-- method Color::init_from_hsl
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "color"
--           , argType = TInterface Name { namespace = "Cogl" , name = "Color" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for a #CoglColor"
--                 , 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 = "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
--           }
--       , 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
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Converts a color expressed in HLS (hue, luminance and saturation)
-- values into a t'GI.Cogl.Structs.Color.Color'.
-- 
-- /Since: 1.16/
colorInitFromHsl ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Float
    -- ^ /@hue@/: hue value, in the 0 .. 360 range
    -> Float
    -- ^ /@saturation@/: saturation value, in the 0 .. 1 range
    -> Float
    -- ^ /@luminance@/: luminance value, in the 0 .. 1 range
    -> m (Color)
colorInitFromHsl :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Float -> Float -> Float -> m Color
colorInitFromHsl Float
hue Float
saturation Float
luminance = 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
16 :: IO (Ptr Color)
    let hue' :: CFloat
hue' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
hue
    let saturation' :: CFloat
saturation' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
saturation
    let luminance' :: CFloat
luminance' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
luminance
    Ptr Color -> CFloat -> CFloat -> CFloat -> IO ()
cogl_color_init_from_hsl Ptr Color
color CFloat
hue' CFloat
saturation' CFloat
luminance'
    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

#if defined(ENABLE_OVERLOADING)
type family ResolveColorMethod (t :: Symbol) (o :: *) :: * where
    ResolveColorMethod "copy" o = ColorCopyMethodInfo
    ResolveColorMethod "free" o = ColorFreeMethodInfo
    ResolveColorMethod "initFrom4f" o = ColorInitFrom4fMethodInfo
    ResolveColorMethod "initFrom4fv" o = ColorInitFrom4fvMethodInfo
    ResolveColorMethod "initFrom4ub" o = ColorInitFrom4ubMethodInfo
    ResolveColorMethod "premultiply" o = ColorPremultiplyMethodInfo
    ResolveColorMethod "toHsl" o = ColorToHslMethodInfo
    ResolveColorMethod "unpremultiply" o = ColorUnpremultiplyMethodInfo
    ResolveColorMethod "getAlpha" o = ColorGetAlphaMethodInfo
    ResolveColorMethod "getAlphaByte" o = ColorGetAlphaByteMethodInfo
    ResolveColorMethod "getAlphaFloat" o = ColorGetAlphaFloatMethodInfo
    ResolveColorMethod "getBlue" o = ColorGetBlueMethodInfo
    ResolveColorMethod "getBlueByte" o = ColorGetBlueByteMethodInfo
    ResolveColorMethod "getBlueFloat" o = ColorGetBlueFloatMethodInfo
    ResolveColorMethod "getGreen" o = ColorGetGreenMethodInfo
    ResolveColorMethod "getGreenByte" o = ColorGetGreenByteMethodInfo
    ResolveColorMethod "getGreenFloat" o = ColorGetGreenFloatMethodInfo
    ResolveColorMethod "getRed" o = ColorGetRedMethodInfo
    ResolveColorMethod "getRedByte" o = ColorGetRedByteMethodInfo
    ResolveColorMethod "getRedFloat" o = ColorGetRedFloatMethodInfo
    ResolveColorMethod "setAlpha" o = ColorSetAlphaMethodInfo
    ResolveColorMethod "setAlphaByte" o = ColorSetAlphaByteMethodInfo
    ResolveColorMethod "setAlphaFloat" o = ColorSetAlphaFloatMethodInfo
    ResolveColorMethod "setBlue" o = ColorSetBlueMethodInfo
    ResolveColorMethod "setBlueByte" o = ColorSetBlueByteMethodInfo
    ResolveColorMethod "setBlueFloat" o = ColorSetBlueFloatMethodInfo
    ResolveColorMethod "setFrom4f" o = ColorSetFrom4fMethodInfo
    ResolveColorMethod "setFrom4ub" o = ColorSetFrom4ubMethodInfo
    ResolveColorMethod "setGreen" o = ColorSetGreenMethodInfo
    ResolveColorMethod "setGreenByte" o = ColorSetGreenByteMethodInfo
    ResolveColorMethod "setGreenFloat" o = ColorSetGreenFloatMethodInfo
    ResolveColorMethod "setRed" o = ColorSetRedMethodInfo
    ResolveColorMethod "setRedByte" o = ColorSetRedByteMethodInfo
    ResolveColorMethod "setRedFloat" o = ColorSetRedFloatMethodInfo
    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