{- | Copyright : Will Thompson, Iñaki García Etxebarria and Jonas Platte License : LGPL-2.1 Maintainer : Iñaki García Etxebarria (garetxe@gmail.com) The #PangoColor structure is used to represent a color in an uncalibrated RGB color-space. -} module GI.Pango.Structs.Color ( -- * Exported types Color(..) , newZeroColor , noColor , -- * Methods -- ** colorCopy ColorCopyMethodInfo , colorCopy , -- ** colorFree ColorFreeMethodInfo , colorFree , -- ** colorParse ColorParseMethodInfo , colorParse , -- ** colorToString ColorToStringMethodInfo , colorToString , -- * Properties -- ** Blue colorReadBlue , -- ** Green colorReadGreen , -- ** Red colorReadRed , ) 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.Pango.Types import GI.Pango.Callbacks newtype Color = Color (ForeignPtr 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 noColor :: Maybe Color noColor = Nothing colorReadRed :: Color -> IO Word16 colorReadRed s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Word16 return val colorReadGreen :: Color -> IO Word16 colorReadGreen s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 2) :: IO Word16 return val colorReadBlue :: Color -> IO Word16 colorReadBlue s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 4) :: IO Word16 return val -- method Color::copy -- method type : OrdinaryMethod -- Args : [Arg {argCName = "_obj", argType = TInterface "Pango" "Color", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}] -- Lengths : [] -- returnType : TInterface "Pango" "Color" -- throws : False -- Skip return : False foreign import ccall "pango_color_copy" pango_color_copy :: Ptr Color -> -- _obj : TInterface "Pango" "Color" IO (Ptr Color) colorCopy :: (MonadIO m) => Color -- _obj -> m Color -- result colorCopy _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_color_copy _obj' checkUnexpectedReturnNULL "pango_color_copy" result result' <- (wrapBoxed Color) result touchManagedPtr _obj return result' data ColorCopyMethodInfo instance (signature ~ (m Color), MonadIO m) => MethodInfo ColorCopyMethodInfo Color signature where overloadedMethod _ = colorCopy -- method Color::free -- method type : OrdinaryMethod -- Args : [Arg {argCName = "_obj", argType = TInterface "Pango" "Color", 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 "pango_color_free" pango_color_free :: Ptr Color -> -- _obj : TInterface "Pango" "Color" IO () colorFree :: (MonadIO m) => Color -- _obj -> m () -- result colorFree _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj pango_color_free _obj' touchManagedPtr _obj return () data ColorFreeMethodInfo instance (signature ~ (m ()), MonadIO m) => MethodInfo ColorFreeMethodInfo Color signature where overloadedMethod _ = colorFree -- method Color::parse -- method type : OrdinaryMethod -- Args : [Arg {argCName = "_obj", argType = TInterface "Pango" "Color", 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 "pango_color_parse" pango_color_parse :: Ptr Color -> -- _obj : TInterface "Pango" "Color" CString -> -- spec : TBasicType TUTF8 IO CInt colorParse :: (MonadIO m) => Color -- _obj -> T.Text -- spec -> m Bool -- result colorParse _obj spec = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj spec' <- textToCString spec result <- pango_color_parse _obj' spec' let result' = (/= 0) result touchManagedPtr _obj freeMem spec' return result' data ColorParseMethodInfo instance (signature ~ (T.Text -> m Bool), MonadIO m) => MethodInfo ColorParseMethodInfo Color signature where overloadedMethod _ = colorParse -- method Color::to_string -- method type : OrdinaryMethod -- Args : [Arg {argCName = "_obj", argType = TInterface "Pango" "Color", 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 "pango_color_to_string" pango_color_to_string :: Ptr Color -> -- _obj : TInterface "Pango" "Color" IO CString colorToString :: (MonadIO m) => Color -- _obj -> m T.Text -- result colorToString _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_color_to_string _obj' checkUnexpectedReturnNULL "pango_color_to_string" result result' <- cstringToText result freeMem result touchManagedPtr _obj return result' data ColorToStringMethodInfo instance (signature ~ (m T.Text), MonadIO m) => MethodInfo ColorToStringMethodInfo Color signature where overloadedMethod _ = colorToString 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 = MethodResolutionFailed l o instance (info ~ ResolveColorMethod t Color, MethodInfo info Color p) => IsLabelProxy t (Color -> p) where fromLabelProxy _ = overloadedMethod (MethodProxy :: MethodProxy info) #if MIN_VERSION_base(4,9,0) instance (info ~ ResolveColorMethod t Color, MethodInfo info Color p) => IsLabel t (Color -> p) where fromLabel _ = overloadedMethod (MethodProxy :: MethodProxy info) #endif