{- | 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.RGBA.RGBA' is used to represent a (possibly translucent) color, in a way that is compatible with cairo’s notion of color. -} #define ENABLE_OVERLOADING (MIN_VERSION_haskell_gi_overloading(1,0,0) \ && !defined(__HADDOCK_VERSION__)) module GI.Gdk.Structs.RGBA ( -- * Exported types RGBA(..) , newZeroRGBA , noRGBA , -- * Methods -- ** copy #method:copy# #if ENABLE_OVERLOADING RGBACopyMethodInfo , #endif rGBACopy , -- ** equal #method:equal# #if ENABLE_OVERLOADING RGBAEqualMethodInfo , #endif rGBAEqual , -- ** free #method:free# #if ENABLE_OVERLOADING RGBAFreeMethodInfo , #endif rGBAFree , -- ** hash #method:hash# #if ENABLE_OVERLOADING RGBAHashMethodInfo , #endif rGBAHash , -- ** parse #method:parse# #if ENABLE_OVERLOADING RGBAParseMethodInfo , #endif rGBAParse , -- ** toString #method:toString# #if ENABLE_OVERLOADING RGBAToStringMethodInfo , #endif rGBAToString , -- * Properties -- ** alpha #attr:alpha# {- | The opacity of the color from 0.0 for completely translucent to 1.0 for opaque -} getRGBAAlpha , #if ENABLE_OVERLOADING rGBA_alpha , #endif setRGBAAlpha , -- ** blue #attr:blue# {- | The intensity of the blue channel from 0.0 to 1.0 inclusive -} getRGBABlue , #if ENABLE_OVERLOADING rGBA_blue , #endif setRGBABlue , -- ** green #attr:green# {- | The intensity of the green channel from 0.0 to 1.0 inclusive -} getRGBAGreen , #if ENABLE_OVERLOADING rGBA_green , #endif setRGBAGreen , -- ** red #attr:red# {- | The intensity of the red channel from 0.0 to 1.0 inclusive -} getRGBARed , #if ENABLE_OVERLOADING rGBA_red , #endif setRGBARed , ) 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 RGBA = RGBA (ManagedPtr 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 instance tag ~ 'AttrSet => Constructible RGBA tag where new _ attrs = do o <- newZeroRGBA GI.Attributes.set o attrs return o -- | A convenience alias for `Nothing` :: `Maybe` `RGBA`. noRGBA :: Maybe RGBA noRGBA = Nothing {- | Get the value of the “@red@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' rGBA #red @ -} getRGBARed :: MonadIO m => RGBA -> m Double getRGBARed s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO CDouble let val' = realToFrac val return val' {- | Set the value of the “@red@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' rGBA [ #red 'Data.GI.Base.Attributes.:=' value ] @ -} setRGBARed :: MonadIO m => RGBA -> Double -> m () setRGBARed s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = realToFrac val poke (ptr `plusPtr` 0) (val' :: CDouble) #if ENABLE_OVERLOADING data RGBARedFieldInfo instance AttrInfo RGBARedFieldInfo where type AttrAllowedOps RGBARedFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint RGBARedFieldInfo = (~) Double type AttrBaseTypeConstraint RGBARedFieldInfo = (~) RGBA type AttrGetType RGBARedFieldInfo = Double type AttrLabel RGBARedFieldInfo = "red" type AttrOrigin RGBARedFieldInfo = RGBA attrGet _ = getRGBARed attrSet _ = setRGBARed attrConstruct = undefined attrClear _ = undefined rGBA_red :: AttrLabelProxy "red" rGBA_red = AttrLabelProxy #endif {- | Get the value of the “@green@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' rGBA #green @ -} getRGBAGreen :: MonadIO m => RGBA -> m Double getRGBAGreen s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO CDouble let val' = realToFrac val return val' {- | Set the value of the “@green@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' rGBA [ #green 'Data.GI.Base.Attributes.:=' value ] @ -} setRGBAGreen :: MonadIO m => RGBA -> Double -> m () setRGBAGreen s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = realToFrac val poke (ptr `plusPtr` 8) (val' :: CDouble) #if ENABLE_OVERLOADING data RGBAGreenFieldInfo instance AttrInfo RGBAGreenFieldInfo where type AttrAllowedOps RGBAGreenFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint RGBAGreenFieldInfo = (~) Double type AttrBaseTypeConstraint RGBAGreenFieldInfo = (~) RGBA type AttrGetType RGBAGreenFieldInfo = Double type AttrLabel RGBAGreenFieldInfo = "green" type AttrOrigin RGBAGreenFieldInfo = RGBA attrGet _ = getRGBAGreen attrSet _ = setRGBAGreen attrConstruct = undefined attrClear _ = undefined rGBA_green :: AttrLabelProxy "green" rGBA_green = AttrLabelProxy #endif {- | Get the value of the “@blue@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' rGBA #blue @ -} getRGBABlue :: MonadIO m => RGBA -> m Double getRGBABlue s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO CDouble let val' = realToFrac val return val' {- | Set the value of the “@blue@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' rGBA [ #blue 'Data.GI.Base.Attributes.:=' value ] @ -} setRGBABlue :: MonadIO m => RGBA -> Double -> m () setRGBABlue s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = realToFrac val poke (ptr `plusPtr` 16) (val' :: CDouble) #if ENABLE_OVERLOADING data RGBABlueFieldInfo instance AttrInfo RGBABlueFieldInfo where type AttrAllowedOps RGBABlueFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint RGBABlueFieldInfo = (~) Double type AttrBaseTypeConstraint RGBABlueFieldInfo = (~) RGBA type AttrGetType RGBABlueFieldInfo = Double type AttrLabel RGBABlueFieldInfo = "blue" type AttrOrigin RGBABlueFieldInfo = RGBA attrGet _ = getRGBABlue attrSet _ = setRGBABlue attrConstruct = undefined attrClear _ = undefined rGBA_blue :: AttrLabelProxy "blue" rGBA_blue = AttrLabelProxy #endif {- | Get the value of the “@alpha@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' rGBA #alpha @ -} getRGBAAlpha :: MonadIO m => RGBA -> m Double getRGBAAlpha s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 24) :: IO CDouble let val' = realToFrac val return val' {- | Set the value of the “@alpha@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' rGBA [ #alpha 'Data.GI.Base.Attributes.:=' value ] @ -} setRGBAAlpha :: MonadIO m => RGBA -> Double -> m () setRGBAAlpha s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = realToFrac val poke (ptr `plusPtr` 24) (val' :: CDouble) #if ENABLE_OVERLOADING data RGBAAlphaFieldInfo instance AttrInfo RGBAAlphaFieldInfo where type AttrAllowedOps RGBAAlphaFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint RGBAAlphaFieldInfo = (~) Double type AttrBaseTypeConstraint RGBAAlphaFieldInfo = (~) RGBA type AttrGetType RGBAAlphaFieldInfo = Double type AttrLabel RGBAAlphaFieldInfo = "alpha" type AttrOrigin RGBAAlphaFieldInfo = RGBA attrGet _ = getRGBAAlpha attrSet _ = setRGBAAlpha attrConstruct = undefined attrClear _ = undefined rGBA_alpha :: AttrLabelProxy "alpha" rGBA_alpha = AttrLabelProxy #endif #if ENABLE_OVERLOADING instance O.HasAttributeList RGBA type instance O.AttributeList RGBA = RGBAAttributeList type RGBAAttributeList = ('[ '("red", RGBARedFieldInfo), '("green", RGBAGreenFieldInfo), '("blue", RGBABlueFieldInfo), '("alpha", RGBAAlphaFieldInfo)] :: [(Symbol, *)]) #endif -- method RGBA::copy -- method type : OrdinaryMethod -- Args : [Arg {argCName = "rgba", argType = TInterface (Name {namespace = "Gdk", name = "RGBA"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GdkRGBA", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}] -- Lengths : [] -- returnType : Just (TInterface (Name {namespace = "Gdk", name = "RGBA"})) -- throws : False -- Skip return : False foreign import ccall "gdk_rgba_copy" gdk_rgba_copy :: Ptr RGBA -> -- rgba : TInterface (Name {namespace = "Gdk", name = "RGBA"}) IO (Ptr RGBA) {- | Makes a copy of a 'GI.Gdk.Structs.RGBA.RGBA'. The result must be freed through 'GI.Gdk.Structs.RGBA.rGBAFree'. /Since: 3.0/ -} rGBACopy :: (B.CallStack.HasCallStack, MonadIO m) => RGBA {- ^ /@rgba@/: a 'GI.Gdk.Structs.RGBA.RGBA' -} -> m RGBA {- ^ __Returns:__ A newly allocated 'GI.Gdk.Structs.RGBA.RGBA', with the same contents as /@rgba@/ -} rGBACopy rgba = liftIO $ do rgba' <- unsafeManagedPtrGetPtr rgba result <- gdk_rgba_copy rgba' checkUnexpectedReturnNULL "rGBACopy" result result' <- (wrapBoxed RGBA) result touchManagedPtr rgba return result' #if ENABLE_OVERLOADING data RGBACopyMethodInfo instance (signature ~ (m RGBA), MonadIO m) => O.MethodInfo RGBACopyMethodInfo RGBA signature where overloadedMethod _ = rGBACopy #endif -- method RGBA::equal -- method type : OrdinaryMethod -- Args : [Arg {argCName = "p1", argType = TInterface (Name {namespace = "Gdk", name = "RGBA"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GdkRGBA pointer", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "p2", argType = TInterface (Name {namespace = "Gdk", name = "RGBA"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "another #GdkRGBA pointer", 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_rgba_equal" gdk_rgba_equal :: Ptr RGBA -> -- p1 : TInterface (Name {namespace = "Gdk", name = "RGBA"}) Ptr RGBA -> -- p2 : TInterface (Name {namespace = "Gdk", name = "RGBA"}) IO CInt {- | Compares two RGBA colors. /Since: 3.0/ -} rGBAEqual :: (B.CallStack.HasCallStack, MonadIO m) => RGBA {- ^ /@p1@/: a 'GI.Gdk.Structs.RGBA.RGBA' pointer -} -> RGBA {- ^ /@p2@/: another 'GI.Gdk.Structs.RGBA.RGBA' pointer -} -> m Bool {- ^ __Returns:__ 'True' if the two colors compare equal -} rGBAEqual p1 p2 = liftIO $ do p1' <- unsafeManagedPtrGetPtr p1 p2' <- unsafeManagedPtrGetPtr p2 result <- gdk_rgba_equal p1' p2' let result' = (/= 0) result touchManagedPtr p1 touchManagedPtr p2 return result' #if ENABLE_OVERLOADING data RGBAEqualMethodInfo instance (signature ~ (RGBA -> m Bool), MonadIO m) => O.MethodInfo RGBAEqualMethodInfo RGBA signature where overloadedMethod _ = rGBAEqual #endif -- method RGBA::free -- method type : OrdinaryMethod -- Args : [Arg {argCName = "rgba", argType = TInterface (Name {namespace = "Gdk", name = "RGBA"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GdkRGBA", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}] -- Lengths : [] -- returnType : Nothing -- throws : False -- Skip return : False foreign import ccall "gdk_rgba_free" gdk_rgba_free :: Ptr RGBA -> -- rgba : TInterface (Name {namespace = "Gdk", name = "RGBA"}) IO () {- | Frees a 'GI.Gdk.Structs.RGBA.RGBA' created with 'GI.Gdk.Structs.RGBA.rGBACopy' /Since: 3.0/ -} rGBAFree :: (B.CallStack.HasCallStack, MonadIO m) => RGBA {- ^ /@rgba@/: a 'GI.Gdk.Structs.RGBA.RGBA' -} -> m () rGBAFree rgba = liftIO $ do rgba' <- unsafeManagedPtrGetPtr rgba gdk_rgba_free rgba' touchManagedPtr rgba return () #if ENABLE_OVERLOADING data RGBAFreeMethodInfo instance (signature ~ (m ()), MonadIO m) => O.MethodInfo RGBAFreeMethodInfo RGBA signature where overloadedMethod _ = rGBAFree #endif -- method RGBA::hash -- method type : OrdinaryMethod -- Args : [Arg {argCName = "p", argType = TInterface (Name {namespace = "Gdk", name = "RGBA"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GdkRGBA pointer", 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_rgba_hash" gdk_rgba_hash :: Ptr RGBA -> -- p : TInterface (Name {namespace = "Gdk", name = "RGBA"}) IO Word32 {- | A hash function suitable for using for a hash table that stores @/GdkRGBAs/@. /Since: 3.0/ -} rGBAHash :: (B.CallStack.HasCallStack, MonadIO m) => RGBA {- ^ /@p@/: a 'GI.Gdk.Structs.RGBA.RGBA' pointer -} -> m Word32 {- ^ __Returns:__ The hash value for /@p@/ -} rGBAHash p = liftIO $ do p' <- unsafeManagedPtrGetPtr p result <- gdk_rgba_hash p' touchManagedPtr p return result #if ENABLE_OVERLOADING data RGBAHashMethodInfo instance (signature ~ (m Word32), MonadIO m) => O.MethodInfo RGBAHashMethodInfo RGBA signature where overloadedMethod _ = rGBAHash #endif -- method RGBA::parse -- method type : OrdinaryMethod -- Args : [Arg {argCName = "rgba", argType = TInterface (Name {namespace = "Gdk", name = "RGBA"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the #GdkRGBA to fill in", 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 "the string specifying the 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 "gdk_rgba_parse" gdk_rgba_parse :: Ptr RGBA -> -- rgba : TInterface (Name {namespace = "Gdk", name = "RGBA"}) CString -> -- spec : TBasicType TUTF8 IO CInt {- | Parses a textual representation of a color, filling in the /@red@/, /@green@/, /@blue@/ and /@alpha@/ fields of the /@rgba@/ 'GI.Gdk.Structs.RGBA.RGBA'. The string can be either one of: * A standard name (Taken from the X11 rgb.txt file). * A hexadecimal value in the form “#rgb”, “#rrggbb”, “#rrrgggbbb” or ”#rrrrggggbbbb” * A RGB color in the form “rgb(r,g,b)” (In this case the color will have full opacity) * A RGBA color in the form “rgba(r,g,b,a)” Where “r”, “g”, “b” and “a” are respectively the red, green, blue and alpha color values. In the last two cases, “r”, “g”, and “b” are either integers in the range 0 to 255 or percentage values in the range 0% to 100%, and a is a floating point value in the range 0 to 1. /Since: 3.0/ -} rGBAParse :: (B.CallStack.HasCallStack, MonadIO m) => RGBA {- ^ /@rgba@/: the 'GI.Gdk.Structs.RGBA.RGBA' to fill in -} -> T.Text {- ^ /@spec@/: the string specifying the color -} -> m Bool {- ^ __Returns:__ 'True' if the parsing succeeded -} rGBAParse rgba spec = liftIO $ do rgba' <- unsafeManagedPtrGetPtr rgba spec' <- textToCString spec result <- gdk_rgba_parse rgba' spec' let result' = (/= 0) result touchManagedPtr rgba freeMem spec' return result' #if ENABLE_OVERLOADING data RGBAParseMethodInfo instance (signature ~ (T.Text -> m Bool), MonadIO m) => O.MethodInfo RGBAParseMethodInfo RGBA signature where overloadedMethod _ = rGBAParse #endif -- method RGBA::to_string -- method type : OrdinaryMethod -- Args : [Arg {argCName = "rgba", argType = TInterface (Name {namespace = "Gdk", name = "RGBA"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GdkRGBA", 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_rgba_to_string" gdk_rgba_to_string :: Ptr RGBA -> -- rgba : TInterface (Name {namespace = "Gdk", name = "RGBA"}) IO CString {- | Returns a textual specification of /@rgba@/ in the form @rgb(r,g,b)@ or @rgba(r g,b,a)@, where “r”, “g”, “b” and “a” represent the red, green, blue and alpha values respectively. “r”, “g”, and “b” are represented as integers in the range 0 to 255, and “a” is represented as a floating point value in the range 0 to 1. These string forms are string forms that are supported by the CSS3 colors module, and can be parsed by 'GI.Gdk.Structs.RGBA.rGBAParse'. Note that this string representation may lose some precision, since “r”, “g” and “b” are represented as 8-bit integers. If this is a concern, you should use a different representation. /Since: 3.0/ -} rGBAToString :: (B.CallStack.HasCallStack, MonadIO m) => RGBA {- ^ /@rgba@/: a 'GI.Gdk.Structs.RGBA.RGBA' -} -> m T.Text {- ^ __Returns:__ A newly allocated text string -} rGBAToString rgba = liftIO $ do rgba' <- unsafeManagedPtrGetPtr rgba result <- gdk_rgba_to_string rgba' checkUnexpectedReturnNULL "rGBAToString" result result' <- cstringToText result freeMem result touchManagedPtr rgba return result' #if ENABLE_OVERLOADING data RGBAToStringMethodInfo instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo RGBAToStringMethodInfo RGBA signature where overloadedMethod _ = rGBAToString #endif #if ENABLE_OVERLOADING 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 = O.MethodResolutionFailed l o instance (info ~ ResolveRGBAMethod t RGBA, O.MethodInfo info RGBA p) => OL.IsLabel t (RGBA -> 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