RGBA.hs


{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)

A #GdkRGBA is used to represent a (possibly translucent)
color, in a way that is compatible with cairos notion of color.
-}

module GI.Gdk.Structs.RGBA
    ( 

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


 -- * Methods
-- ** rGBACopy
    RGBACopyMethodInfo                      ,
    rGBACopy                                ,


-- ** rGBAEqual
    RGBAEqualMethodInfo                     ,
    rGBAEqual                               ,


-- ** rGBAFree
    RGBAFreeMethodInfo                      ,
    rGBAFree                                ,


-- ** rGBAHash
    RGBAHashMethodInfo                      ,
    rGBAHash                                ,


-- ** rGBAParse
    RGBAParseMethodInfo                     ,
    rGBAParse                               ,


-- ** rGBAToString
    RGBAToStringMethodInfo                  ,
    rGBAToString                            ,




 -- * Properties
-- ** Alpha
    rGBAReadAlpha                           ,


-- ** Blue
    rGBAReadBlue                            ,


-- ** Green
    rGBAReadGreen                           ,


-- ** Red
    rGBAReadRed                             ,




    ) where

import Prelude ()
import Data.GI.Base.ShortPrelude

import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map

import GI.Gdk.Types
import GI.Gdk.Callbacks

newtype RGBA = RGBA (ForeignPtr RGBA)
foreign import ccall "gdk_rgba_get_type" c_gdk_rgba_get_type :: 
    IO GType

instance BoxedObject RGBA where
    boxedType _ = c_gdk_rgba_get_type

-- | Construct a `RGBA` struct initialized to zero.
newZeroRGBA :: MonadIO m => m RGBA
newZeroRGBA = liftIO $ callocBoxedBytes 32 >>= wrapBoxed RGBA

noRGBA :: Maybe RGBA
noRGBA = Nothing

rGBAReadRed :: RGBA -> IO Double
rGBAReadRed s = withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO CDouble
    let val' = realToFrac val
    return val'

rGBAReadGreen :: RGBA -> IO Double
rGBAReadGreen s = withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 8) :: IO CDouble
    let val' = realToFrac val
    return val'

rGBAReadBlue :: RGBA -> IO Double
rGBAReadBlue s = withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 16) :: IO CDouble
    let val' = realToFrac val
    return val'

rGBAReadAlpha :: RGBA -> IO Double
rGBAReadAlpha s = withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 24) :: IO CDouble
    let val' = realToFrac val
    return val'

-- method RGBA::copy
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "_obj", argType = TInterface "Gdk" "RGBA", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : TInterface "Gdk" "RGBA"
-- throws : False
-- Skip return : False

foreign import ccall "gdk_rgba_copy" gdk_rgba_copy :: 
    Ptr RGBA ->                             -- _obj : TInterface "Gdk" "RGBA"
    IO (Ptr RGBA)


rGBACopy ::
    (MonadIO m) =>
    RGBA                                    -- _obj
    -> m RGBA                               -- result
rGBACopy _obj = liftIO $ do
    let _obj' = unsafeManagedPtrGetPtr _obj
    result <- gdk_rgba_copy _obj'
    checkUnexpectedReturnNULL "gdk_rgba_copy" result
    result' <- (wrapBoxed RGBA) result
    touchManagedPtr _obj
    return result'

data RGBACopyMethodInfo
instance (signature ~ (m RGBA), MonadIO m) => MethodInfo RGBACopyMethodInfo RGBA signature where
    overloadedMethod _ = rGBACopy

-- method RGBA::equal
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "_obj", argType = TInterface "Gdk" "RGBA", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "p2", argType = TInterface "Gdk" "RGBA", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gdk_rgba_equal" gdk_rgba_equal :: 
    Ptr RGBA ->                             -- _obj : TInterface "Gdk" "RGBA"
    Ptr RGBA ->                             -- p2 : TInterface "Gdk" "RGBA"
    IO CInt


rGBAEqual ::
    (MonadIO m) =>
    RGBA                                    -- _obj
    -> RGBA                                 -- p2
    -> m Bool                               -- result
rGBAEqual _obj p2 = liftIO $ do
    let _obj' = unsafeManagedPtrGetPtr _obj
    let p2' = unsafeManagedPtrGetPtr p2
    result <- gdk_rgba_equal _obj' p2'
    let result' = (/= 0) result
    touchManagedPtr _obj
    touchManagedPtr p2
    return result'

data RGBAEqualMethodInfo
instance (signature ~ (RGBA -> m Bool), MonadIO m) => MethodInfo RGBAEqualMethodInfo RGBA signature where
    overloadedMethod _ = rGBAEqual

-- method RGBA::free
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "_obj", argType = TInterface "Gdk" "RGBA", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_rgba_free" gdk_rgba_free :: 
    Ptr RGBA ->                             -- _obj : TInterface "Gdk" "RGBA"
    IO ()


rGBAFree ::
    (MonadIO m) =>
    RGBA                                    -- _obj
    -> m ()                                 -- result
rGBAFree _obj = liftIO $ do
    let _obj' = unsafeManagedPtrGetPtr _obj
    gdk_rgba_free _obj'
    touchManagedPtr _obj
    return ()

data RGBAFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => MethodInfo RGBAFreeMethodInfo RGBA signature where
    overloadedMethod _ = rGBAFree

-- method RGBA::hash
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "_obj", argType = TInterface "Gdk" "RGBA", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : TBasicType TUInt32
-- throws : False
-- Skip return : False

foreign import ccall "gdk_rgba_hash" gdk_rgba_hash :: 
    Ptr RGBA ->                             -- _obj : TInterface "Gdk" "RGBA"
    IO Word32


rGBAHash ::
    (MonadIO m) =>
    RGBA                                    -- _obj
    -> m Word32                             -- result
rGBAHash _obj = liftIO $ do
    let _obj' = unsafeManagedPtrGetPtr _obj
    result <- gdk_rgba_hash _obj'
    touchManagedPtr _obj
    return result

data RGBAHashMethodInfo
instance (signature ~ (m Word32), MonadIO m) => MethodInfo RGBAHashMethodInfo RGBA signature where
    overloadedMethod _ = rGBAHash

-- method RGBA::parse
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "_obj", argType = TInterface "Gdk" "RGBA", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "spec", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gdk_rgba_parse" gdk_rgba_parse :: 
    Ptr RGBA ->                             -- _obj : TInterface "Gdk" "RGBA"
    CString ->                              -- spec : TBasicType TUTF8
    IO CInt


rGBAParse ::
    (MonadIO m) =>
    RGBA                                    -- _obj
    -> T.Text                               -- spec
    -> m Bool                               -- result
rGBAParse _obj spec = liftIO $ do
    let _obj' = unsafeManagedPtrGetPtr _obj
    spec' <- textToCString spec
    result <- gdk_rgba_parse _obj' spec'
    let result' = (/= 0) result
    touchManagedPtr _obj
    freeMem spec'
    return result'

data RGBAParseMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m) => MethodInfo RGBAParseMethodInfo RGBA signature where
    overloadedMethod _ = rGBAParse

-- method RGBA::to_string
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "_obj", argType = TInterface "Gdk" "RGBA", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : TBasicType TUTF8
-- throws : False
-- Skip return : False

foreign import ccall "gdk_rgba_to_string" gdk_rgba_to_string :: 
    Ptr RGBA ->                             -- _obj : TInterface "Gdk" "RGBA"
    IO CString


rGBAToString ::
    (MonadIO m) =>
    RGBA                                    -- _obj
    -> m T.Text                             -- result
rGBAToString _obj = liftIO $ do
    let _obj' = unsafeManagedPtrGetPtr _obj
    result <- gdk_rgba_to_string _obj'
    checkUnexpectedReturnNULL "gdk_rgba_to_string" result
    result' <- cstringToText result
    freeMem result
    touchManagedPtr _obj
    return result'

data RGBAToStringMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => MethodInfo RGBAToStringMethodInfo RGBA signature where
    overloadedMethod _ = rGBAToString

type family ResolveRGBAMethod (t :: Symbol) (o :: *) :: * where
    ResolveRGBAMethod "copy" o = RGBACopyMethodInfo
    ResolveRGBAMethod "equal" o = RGBAEqualMethodInfo
    ResolveRGBAMethod "free" o = RGBAFreeMethodInfo
    ResolveRGBAMethod "hash" o = RGBAHashMethodInfo
    ResolveRGBAMethod "parse" o = RGBAParseMethodInfo
    ResolveRGBAMethod "toString" o = RGBAToStringMethodInfo
    ResolveRGBAMethod l o = MethodResolutionFailed l o

instance (info ~ ResolveRGBAMethod t RGBA, MethodInfo info RGBA p) => IsLabelProxy t (RGBA -> p) where
    fromLabelProxy _ = overloadedMethod (MethodProxy :: MethodProxy info)

#if MIN_VERSION_base(4,9,0)
instance (info ~ ResolveRGBAMethod t RGBA, MethodInfo info RGBA p) => IsLabel t (RGBA -> p) where
    fromLabel _ = overloadedMethod (MethodProxy :: MethodProxy info)
#endif