{- | Copyright : Will Thompson, Iñaki García Etxebarria and Jonas Platte License : LGPL-2.1 Maintainer : Iñaki García Etxebarria (inaki@blueleaf.cc) A 'GI.Gdk.Structs.Color.Color' is used to describe a color, similar to the XColor struct used in the X11 drawing API. -} #define ENABLE_OVERLOADING (MIN_VERSION_haskell_gi_overloading(1,0,0) \ && !defined(__HADDOCK_VERSION__)) module GI.Gdk.Structs.Color ( -- * Exported types Color(..) , newZeroColor , noColor , -- * Methods -- ** copy #method:copy# #if ENABLE_OVERLOADING ColorCopyMethodInfo , #endif colorCopy , -- ** equal #method:equal# #if ENABLE_OVERLOADING ColorEqualMethodInfo , #endif colorEqual , -- ** free #method:free# #if ENABLE_OVERLOADING ColorFreeMethodInfo , #endif colorFree , -- ** hash #method:hash# #if ENABLE_OVERLOADING ColorHashMethodInfo , #endif colorHash , -- ** parse #method:parse# colorParse , -- ** toString #method:toString# #if ENABLE_OVERLOADING ColorToStringMethodInfo , #endif colorToString , -- * Properties -- ** blue #attr:blue# {- | The blue component of the color -} #if ENABLE_OVERLOADING color_blue , #endif getColorBlue , setColorBlue , -- ** green #attr:green# {- | The green component of the color -} #if ENABLE_OVERLOADING color_green , #endif getColorGreen , setColorGreen , -- ** pixel #attr:pixel# {- | For allocated colors, the pixel value used to draw this color on the screen. Not used anymore. -} #if ENABLE_OVERLOADING color_pixel , #endif getColorPixel , setColorPixel , -- ** red #attr:red# {- | The red component of the color. This is a value between 0 and 65535, with 65535 indicating full intensity -} #if ENABLE_OVERLOADING color_red , #endif getColorRed , setColorRed , ) where import Data.GI.Base.ShortPrelude import qualified Data.GI.Base.ShortPrelude as SP import qualified Data.GI.Base.Overloading as O import qualified Prelude as P import qualified Data.GI.Base.Attributes as GI.Attributes import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr import qualified Data.GI.Base.GClosure as B.GClosure import qualified Data.GI.Base.GError as B.GError 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.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 -- | Memory-managed wrapper type. newtype Color = Color (ManagedPtr Color) foreign import ccall "gdk_color_get_type" c_gdk_color_get_type :: IO GType instance BoxedObject Color where boxedType _ = c_gdk_color_get_type -- | Construct a `Color` struct initialized to zero. newZeroColor :: MonadIO m => m Color newZeroColor = liftIO $ callocBoxedBytes 12 >>= wrapBoxed Color instance tag ~ 'AttrSet => Constructible Color tag where new _ attrs = do o <- newZeroColor GI.Attributes.set o attrs return o -- | A convenience alias for `Nothing` :: `Maybe` `Color`. noColor :: Maybe Color noColor = Nothing {- | Get the value of the “@pixel@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' color #pixel @ -} getColorPixel :: MonadIO m => Color -> m Word32 getColorPixel s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Word32 return val {- | Set the value of the “@pixel@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' color [ #pixel 'Data.GI.Base.Attributes.:=' value ] @ -} setColorPixel :: MonadIO m => Color -> Word32 -> m () setColorPixel s val = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 0) (val :: Word32) #if ENABLE_OVERLOADING data ColorPixelFieldInfo instance AttrInfo ColorPixelFieldInfo where type AttrAllowedOps ColorPixelFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint ColorPixelFieldInfo = (~) Word32 type AttrBaseTypeConstraint ColorPixelFieldInfo = (~) Color type AttrGetType ColorPixelFieldInfo = Word32 type AttrLabel ColorPixelFieldInfo = "pixel" type AttrOrigin ColorPixelFieldInfo = Color attrGet _ = getColorPixel attrSet _ = setColorPixel attrConstruct = undefined attrClear _ = undefined color_pixel :: AttrLabelProxy "pixel" color_pixel = AttrLabelProxy #endif {- | Get the value of the “@red@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' color #red @ -} getColorRed :: MonadIO m => Color -> m Word16 getColorRed s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 4) :: IO Word16 return val {- | Set the value of the “@red@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' color [ #red 'Data.GI.Base.Attributes.:=' value ] @ -} setColorRed :: MonadIO m => Color -> Word16 -> m () setColorRed s val = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 4) (val :: Word16) #if ENABLE_OVERLOADING data ColorRedFieldInfo instance AttrInfo ColorRedFieldInfo where type AttrAllowedOps ColorRedFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint ColorRedFieldInfo = (~) Word16 type AttrBaseTypeConstraint ColorRedFieldInfo = (~) Color type AttrGetType ColorRedFieldInfo = Word16 type AttrLabel ColorRedFieldInfo = "red" type AttrOrigin ColorRedFieldInfo = Color attrGet _ = getColorRed attrSet _ = setColorRed attrConstruct = undefined attrClear _ = undefined color_red :: AttrLabelProxy "red" color_red = AttrLabelProxy #endif {- | Get the value of the “@green@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' color #green @ -} getColorGreen :: MonadIO m => Color -> m Word16 getColorGreen s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 6) :: IO Word16 return val {- | Set the value of the “@green@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' color [ #green 'Data.GI.Base.Attributes.:=' value ] @ -} setColorGreen :: MonadIO m => Color -> Word16 -> m () setColorGreen s val = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 6) (val :: Word16) #if ENABLE_OVERLOADING data ColorGreenFieldInfo instance AttrInfo ColorGreenFieldInfo where type AttrAllowedOps ColorGreenFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint ColorGreenFieldInfo = (~) Word16 type AttrBaseTypeConstraint ColorGreenFieldInfo = (~) Color type AttrGetType ColorGreenFieldInfo = Word16 type AttrLabel ColorGreenFieldInfo = "green" type AttrOrigin ColorGreenFieldInfo = Color attrGet _ = getColorGreen attrSet _ = setColorGreen attrConstruct = undefined attrClear _ = undefined color_green :: AttrLabelProxy "green" color_green = AttrLabelProxy #endif {- | Get the value of the “@blue@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' color #blue @ -} getColorBlue :: MonadIO m => Color -> m Word16 getColorBlue s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO Word16 return val {- | Set the value of the “@blue@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' color [ #blue 'Data.GI.Base.Attributes.:=' value ] @ -} setColorBlue :: MonadIO m => Color -> Word16 -> m () setColorBlue s val = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 8) (val :: Word16) #if ENABLE_OVERLOADING data ColorBlueFieldInfo instance AttrInfo ColorBlueFieldInfo where type AttrAllowedOps ColorBlueFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint ColorBlueFieldInfo = (~) Word16 type AttrBaseTypeConstraint ColorBlueFieldInfo = (~) Color type AttrGetType ColorBlueFieldInfo = Word16 type AttrLabel ColorBlueFieldInfo = "blue" type AttrOrigin ColorBlueFieldInfo = Color attrGet _ = getColorBlue attrSet _ = setColorBlue attrConstruct = undefined attrClear _ = undefined color_blue :: AttrLabelProxy "blue" color_blue = AttrLabelProxy #endif #if ENABLE_OVERLOADING instance O.HasAttributeList Color type instance O.AttributeList Color = ColorAttributeList type ColorAttributeList = ('[ '("pixel", ColorPixelFieldInfo), '("red", ColorRedFieldInfo), '("green", ColorGreenFieldInfo), '("blue", ColorBlueFieldInfo)] :: [(Symbol, *)]) #endif -- method Color::copy -- method type : OrdinaryMethod -- Args : [Arg {argCName = "color", argType = TInterface (Name {namespace = "Gdk", name = "Color"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GdkColor", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}] -- Lengths : [] -- returnType : Just (TInterface (Name {namespace = "Gdk", name = "Color"})) -- throws : False -- Skip return : False foreign import ccall "gdk_color_copy" gdk_color_copy :: Ptr Color -> -- color : TInterface (Name {namespace = "Gdk", name = "Color"}) IO (Ptr Color) {-# DEPRECATED colorCopy ["(Since version 3.14)","Use 'GI.Gdk.Structs.RGBA.RGBA'"] #-} {- | Makes a copy of a 'GI.Gdk.Structs.Color.Color'. The result must be freed using 'GI.Gdk.Structs.Color.colorFree'. -} colorCopy :: (B.CallStack.HasCallStack, MonadIO m) => Color {- ^ /@color@/: a 'GI.Gdk.Structs.Color.Color' -} -> m Color {- ^ __Returns:__ a copy of /@color@/ -} colorCopy color = liftIO $ do color' <- unsafeManagedPtrGetPtr color result <- gdk_color_copy color' checkUnexpectedReturnNULL "colorCopy" result result' <- (wrapBoxed Color) result touchManagedPtr color return result' #if ENABLE_OVERLOADING data ColorCopyMethodInfo instance (signature ~ (m Color), MonadIO m) => O.MethodInfo ColorCopyMethodInfo Color signature where overloadedMethod _ = colorCopy #endif -- method Color::equal -- method type : OrdinaryMethod -- Args : [Arg {argCName = "colora", argType = TInterface (Name {namespace = "Gdk", name = "Color"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GdkColor", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "colorb", argType = TInterface (Name {namespace = "Gdk", name = "Color"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "another #GdkColor", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}] -- Lengths : [] -- returnType : Just (TBasicType TBoolean) -- throws : False -- Skip return : False foreign import ccall "gdk_color_equal" gdk_color_equal :: Ptr Color -> -- colora : TInterface (Name {namespace = "Gdk", name = "Color"}) Ptr Color -> -- colorb : TInterface (Name {namespace = "Gdk", name = "Color"}) IO CInt {-# DEPRECATED colorEqual ["(Since version 3.14)","Use 'GI.Gdk.Structs.RGBA.RGBA'"] #-} {- | Compares two colors. -} colorEqual :: (B.CallStack.HasCallStack, MonadIO m) => Color {- ^ /@colora@/: a 'GI.Gdk.Structs.Color.Color' -} -> Color {- ^ /@colorb@/: another 'GI.Gdk.Structs.Color.Color' -} -> m Bool {- ^ __Returns:__ 'True' if the two colors compare equal -} colorEqual colora colorb = liftIO $ do colora' <- unsafeManagedPtrGetPtr colora colorb' <- unsafeManagedPtrGetPtr colorb result <- gdk_color_equal colora' colorb' let result' = (/= 0) result touchManagedPtr colora touchManagedPtr colorb return result' #if ENABLE_OVERLOADING data ColorEqualMethodInfo instance (signature ~ (Color -> m Bool), MonadIO m) => O.MethodInfo ColorEqualMethodInfo Color signature where overloadedMethod _ = colorEqual #endif -- method Color::free -- method type : OrdinaryMethod -- Args : [Arg {argCName = "color", argType = TInterface (Name {namespace = "Gdk", name = "Color"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GdkColor", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}] -- Lengths : [] -- returnType : Nothing -- throws : False -- Skip return : False foreign import ccall "gdk_color_free" gdk_color_free :: Ptr Color -> -- color : TInterface (Name {namespace = "Gdk", name = "Color"}) IO () {-# DEPRECATED colorFree ["(Since version 3.14)","Use 'GI.Gdk.Structs.RGBA.RGBA'"] #-} {- | Frees a 'GI.Gdk.Structs.Color.Color' created with 'GI.Gdk.Structs.Color.colorCopy'. -} colorFree :: (B.CallStack.HasCallStack, MonadIO m) => Color {- ^ /@color@/: a 'GI.Gdk.Structs.Color.Color' -} -> m () colorFree color = liftIO $ do color' <- unsafeManagedPtrGetPtr color gdk_color_free color' touchManagedPtr color return () #if ENABLE_OVERLOADING data ColorFreeMethodInfo instance (signature ~ (m ()), MonadIO m) => O.MethodInfo ColorFreeMethodInfo Color signature where overloadedMethod _ = colorFree #endif -- method Color::hash -- method type : OrdinaryMethod -- Args : [Arg {argCName = "color", argType = TInterface (Name {namespace = "Gdk", name = "Color"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GdkColor", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}] -- Lengths : [] -- returnType : Just (TBasicType TUInt) -- throws : False -- Skip return : False foreign import ccall "gdk_color_hash" gdk_color_hash :: Ptr Color -> -- color : TInterface (Name {namespace = "Gdk", name = "Color"}) IO Word32 {-# DEPRECATED colorHash ["(Since version 3.14)","Use 'GI.Gdk.Structs.RGBA.RGBA'"] #-} {- | A hash function suitable for using for a hash table that stores @/GdkColors/@. -} colorHash :: (B.CallStack.HasCallStack, MonadIO m) => Color {- ^ /@color@/: a 'GI.Gdk.Structs.Color.Color' -} -> m Word32 {- ^ __Returns:__ The hash function applied to /@color@/ -} colorHash color = liftIO $ do color' <- unsafeManagedPtrGetPtr color result <- gdk_color_hash color' touchManagedPtr color return result #if ENABLE_OVERLOADING data ColorHashMethodInfo instance (signature ~ (m Word32), MonadIO m) => O.MethodInfo ColorHashMethodInfo Color signature where overloadedMethod _ = colorHash #endif -- method Color::to_string -- method type : OrdinaryMethod -- Args : [Arg {argCName = "color", argType = TInterface (Name {namespace = "Gdk", name = "Color"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GdkColor", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}] -- Lengths : [] -- returnType : Just (TBasicType TUTF8) -- throws : False -- Skip return : False foreign import ccall "gdk_color_to_string" gdk_color_to_string :: Ptr Color -> -- color : TInterface (Name {namespace = "Gdk", name = "Color"}) IO CString {-# DEPRECATED colorToString ["(Since version 3.14)","Use 'GI.Gdk.Structs.RGBA.RGBA'"] #-} {- | Returns a textual specification of /@color@/ in the hexadecimal form “#rrrrggggbbbb” where “r”, “g” and “b” are hex digits representing the red, green and blue components respectively. The returned string can be parsed by 'GI.Gdk.Functions.colorParse'. /Since: 2.12/ -} colorToString :: (B.CallStack.HasCallStack, MonadIO m) => Color {- ^ /@color@/: a 'GI.Gdk.Structs.Color.Color' -} -> m T.Text {- ^ __Returns:__ a newly-allocated text string -} colorToString color = liftIO $ do color' <- unsafeManagedPtrGetPtr color result <- gdk_color_to_string color' checkUnexpectedReturnNULL "colorToString" result result' <- cstringToText result freeMem result touchManagedPtr color return result' #if ENABLE_OVERLOADING data ColorToStringMethodInfo instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo ColorToStringMethodInfo Color signature where overloadedMethod _ = colorToString #endif -- method Color::parse -- method type : MemberFunction -- Args : [Arg {argCName = "spec", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the string specifying the color", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "color", argType = TInterface (Name {namespace = "Gdk", name = "Color"}), direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the #GdkColor to fill in", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = True, transfer = TransferNothing}] -- Lengths : [] -- returnType : Just (TBasicType TBoolean) -- throws : False -- Skip return : False foreign import ccall "gdk_color_parse" gdk_color_parse :: CString -> -- spec : TBasicType TUTF8 Ptr Color -> -- color : TInterface (Name {namespace = "Gdk", name = "Color"}) IO CInt {-# DEPRECATED colorParse ["(Since version 3.14)","Use 'GI.Gdk.Structs.RGBA.RGBA'"] #-} {- | Parses a textual specification of a color and fill in the /@red@/, /@green@/, and /@blue@/ fields of a 'GI.Gdk.Structs.Color.Color'. The string can either one of a large set of standard names (taken from the X11 @rgb.txt@ file), or it can be a hexadecimal value in the form “#rgb” “#rrggbb”, “#rrrgggbbb” or “#rrrrggggbbbb” where “r”, “g” and “b” are hex digits of the red, green, and blue components of the color, respectively. (White in the four forms is “#fff”, “#ffffff”, “#fffffffff” and “#ffffffffffff”). -} colorParse :: (B.CallStack.HasCallStack, MonadIO m) => T.Text {- ^ /@spec@/: the string specifying the color -} -> m ((Bool, Color)) {- ^ __Returns:__ 'True' if the parsing succeeded -} colorParse spec = liftIO $ do spec' <- textToCString spec color <- callocBoxedBytes 12 :: IO (Ptr Color) result <- gdk_color_parse spec' color let result' = (/= 0) result color' <- (wrapBoxed Color) color freeMem spec' return (result', color') #if ENABLE_OVERLOADING #endif #if ENABLE_OVERLOADING type family ResolveColorMethod (t :: Symbol) (o :: *) :: * where ResolveColorMethod "copy" o = ColorCopyMethodInfo ResolveColorMethod "equal" o = ColorEqualMethodInfo ResolveColorMethod "free" o = ColorFreeMethodInfo ResolveColorMethod "hash" o = ColorHashMethodInfo ResolveColorMethod "toString" o = ColorToStringMethodInfo ResolveColorMethod l o = O.MethodResolutionFailed l o instance (info ~ ResolveColorMethod t Color, O.MethodInfo info Color p) => OL.IsLabel t (Color -> p) where #if MIN_VERSION_base(4,10,0) fromLabel = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info) #else fromLabel _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info) #endif #endif