{- | Copyright : Will Thompson, Iñaki García Etxebarria and Jonas Platte License : LGPL-2.1 Maintainer : Iñaki García Etxebarria (inaki@blueleaf.cc) The 'GI.Pango.Structs.Color.Color' structure is used to represent a color in an uncalibrated RGB color-space. -} #define ENABLE_OVERLOADING (MIN_VERSION_haskell_gi_overloading(1,0,0) \ && !defined(__HADDOCK_VERSION__)) module GI.Pango.Structs.Color ( -- * Exported types Color(..) , newZeroColor , noColor , -- * Methods -- ** copy #method:copy# #if ENABLE_OVERLOADING ColorCopyMethodInfo , #endif colorCopy , -- ** free #method:free# #if ENABLE_OVERLOADING ColorFreeMethodInfo , #endif colorFree , -- ** parse #method:parse# #if ENABLE_OVERLOADING ColorParseMethodInfo , #endif colorParse , -- ** toString #method:toString# #if ENABLE_OVERLOADING ColorToStringMethodInfo , #endif colorToString , -- * Properties -- ** blue #attr:blue# {- | value of blue component -} #if ENABLE_OVERLOADING color_blue , #endif getColorBlue , setColorBlue , -- ** green #attr:green# {- | value of green component -} #if ENABLE_OVERLOADING color_green , #endif getColorGreen , setColorGreen , -- ** red #attr:red# {- | value of red component -} #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 "pango_color_get_type" c_pango_color_get_type :: IO GType instance BoxedObject Color where boxedType _ = c_pango_color_get_type -- | Construct a `Color` struct initialized to zero. newZeroColor :: MonadIO m => m Color newZeroColor = liftIO $ callocBoxedBytes 6 >>= 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 “@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` 0) :: 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` 0) (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` 2) :: 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` 2) (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` 4) :: 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` 4) (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 = ('[ '("red", ColorRedFieldInfo), '("green", ColorGreenFieldInfo), '("blue", ColorBlueFieldInfo)] :: [(Symbol, *)]) #endif -- method Color::copy -- method type : OrdinaryMethod -- Args : [Arg {argCName = "src", argType = TInterface (Name {namespace = "Pango", name = "Color"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "color to copy, may be %NULL", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}] -- Lengths : [] -- returnType : Just (TInterface (Name {namespace = "Pango", name = "Color"})) -- throws : False -- Skip return : False foreign import ccall "pango_color_copy" pango_color_copy :: Ptr Color -> -- src : TInterface (Name {namespace = "Pango", name = "Color"}) IO (Ptr Color) {- | Creates a copy of /@src@/, which should be freed with 'GI.Pango.Structs.Color.colorFree'. Primarily used by language bindings, not that useful otherwise (since colors can just be copied by assignment in C). -} colorCopy :: (B.CallStack.HasCallStack, MonadIO m) => Color {- ^ /@src@/: color to copy, may be 'Nothing' -} -> m (Maybe Color) {- ^ __Returns:__ the newly allocated 'GI.Pango.Structs.Color.Color', which should be freed with 'GI.Pango.Structs.Color.colorFree', or 'Nothing' if /@src@/ was 'Nothing'. -} colorCopy src = liftIO $ do src' <- unsafeManagedPtrGetPtr src result <- pango_color_copy src' maybeResult <- convertIfNonNull result $ \result' -> do result'' <- (wrapBoxed Color) result' return result'' touchManagedPtr src return maybeResult #if ENABLE_OVERLOADING data ColorCopyMethodInfo instance (signature ~ (m (Maybe Color)), MonadIO m) => O.MethodInfo ColorCopyMethodInfo Color signature where overloadedMethod _ = colorCopy #endif -- method Color::free -- method type : OrdinaryMethod -- Args : [Arg {argCName = "color", argType = TInterface (Name {namespace = "Pango", name = "Color"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "an allocated #PangoColor, may be %NULL", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}] -- Lengths : [] -- returnType : Nothing -- throws : False -- Skip return : False foreign import ccall "pango_color_free" pango_color_free :: Ptr Color -> -- color : TInterface (Name {namespace = "Pango", name = "Color"}) IO () {- | Frees a color allocated by 'GI.Pango.Structs.Color.colorCopy'. -} colorFree :: (B.CallStack.HasCallStack, MonadIO m) => Color {- ^ /@color@/: an allocated 'GI.Pango.Structs.Color.Color', may be 'Nothing' -} -> m () colorFree color = liftIO $ do color' <- unsafeManagedPtrGetPtr color pango_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::parse -- method type : OrdinaryMethod -- Args : [Arg {argCName = "color", argType = TInterface (Name {namespace = "Pango", name = "Color"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #PangoColor structure in which to store the\n result, or %NULL", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "spec", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a string specifying the new color", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}] -- Lengths : [] -- returnType : Just (TBasicType TBoolean) -- throws : False -- Skip return : False foreign import ccall "pango_color_parse" pango_color_parse :: Ptr Color -> -- color : TInterface (Name {namespace = "Pango", name = "Color"}) CString -> -- spec : TBasicType TUTF8 IO CInt {- | Fill in the fields of a color from a string specification. The string can either one of a large set of standard names. (Taken from the CSS \specification\<\/ulink>), 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) => Color {- ^ /@color@/: a 'GI.Pango.Structs.Color.Color' structure in which to store the result, or 'Nothing' -} -> T.Text {- ^ /@spec@/: a string specifying the new color -} -> m Bool {- ^ __Returns:__ 'True' if parsing of the specifier succeeded, otherwise false. -} colorParse color spec = liftIO $ do color' <- unsafeManagedPtrGetPtr color spec' <- textToCString spec result <- pango_color_parse color' spec' let result' = (/= 0) result touchManagedPtr color freeMem spec' return result' #if ENABLE_OVERLOADING data ColorParseMethodInfo instance (signature ~ (T.Text -> m Bool), MonadIO m) => O.MethodInfo ColorParseMethodInfo Color signature where overloadedMethod _ = colorParse #endif -- method Color::to_string -- method type : OrdinaryMethod -- Args : [Arg {argCName = "color", argType = TInterface (Name {namespace = "Pango", name = "Color"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #PangoColor", 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 "pango_color_to_string" pango_color_to_string :: Ptr Color -> -- color : TInterface (Name {namespace = "Pango", name = "Color"}) IO CString {- | Returns a textual specification of /@color@/ in the hexadecimal form \#rrrrggggbbbb\<\/literal>, where \r\<\/literal>, \g\<\/literal> and \b\<\/literal> are hex digits representing the red, green, and blue components respectively. /Since: 1.16/ -} colorToString :: (B.CallStack.HasCallStack, MonadIO m) => Color {- ^ /@color@/: a 'GI.Pango.Structs.Color.Color' -} -> m T.Text {- ^ __Returns:__ a newly-allocated text string that must be freed with 'GI.GLib.Functions.free'. -} colorToString color = liftIO $ do color' <- unsafeManagedPtrGetPtr color result <- pango_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 #if ENABLE_OVERLOADING type family ResolveColorMethod (t :: Symbol) (o :: *) :: * where ResolveColorMethod "copy" o = ColorCopyMethodInfo ResolveColorMethod "free" o = ColorFreeMethodInfo ResolveColorMethod "parse" o = ColorParseMethodInfo 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