{-# LANGUAGE TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.Pango.Structs.Color
(
Color(..) ,
newZeroColor ,
noColor ,
#if defined(ENABLE_OVERLOADING)
ResolveColorMethod ,
#endif
#if defined(ENABLE_OVERLOADING)
ColorCopyMethodInfo ,
#endif
colorCopy ,
#if defined(ENABLE_OVERLOADING)
ColorFreeMethodInfo ,
#endif
colorFree ,
#if defined(ENABLE_OVERLOADING)
ColorParseMethodInfo ,
#endif
colorParse ,
#if defined(ENABLE_OVERLOADING)
ColorToStringMethodInfo ,
#endif
colorToString ,
#if defined(ENABLE_OVERLOADING)
color_blue ,
#endif
getColorBlue ,
setColorBlue ,
#if defined(ENABLE_OVERLOADING)
color_green ,
#endif
getColorGreen ,
setColorGreen ,
#if defined(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.GI.Base.Signals as B.Signals
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
newtype Color = Color (ManagedPtr Color)
deriving (Eq)
foreign import ccall "pango_color_get_type" c_pango_color_get_type ::
IO GType
instance BoxedObject Color where
boxedType _ = c_pango_color_get_type
instance B.GValue.IsGValue Color where
toGValue o = do
gtype <- c_pango_color_get_type
B.ManagedPtr.withManagedPtr o (B.GValue.buildGValue gtype B.GValue.set_boxed)
fromGValue gv = do
ptr <- B.GValue.get_boxed gv :: IO (Ptr Color)
B.ManagedPtr.newBoxed Color ptr
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
noColor :: Maybe Color
noColor = Nothing
getColorRed :: MonadIO m => Color -> m Word16
getColorRed s = liftIO $ withManagedPtr s $ \ptr -> do
val <- peek (ptr `plusPtr` 0) :: IO Word16
return val
setColorRed :: MonadIO m => Color -> Word16 -> m ()
setColorRed s val = liftIO $ withManagedPtr s $ \ptr -> do
poke (ptr `plusPtr` 0) (val :: Word16)
#if defined(ENABLE_OVERLOADING)
data ColorRedFieldInfo
instance AttrInfo ColorRedFieldInfo where
type AttrBaseTypeConstraint ColorRedFieldInfo = (~) Color
type AttrAllowedOps ColorRedFieldInfo = '[ 'AttrSet, 'AttrGet]
type AttrSetTypeConstraint ColorRedFieldInfo = (~) Word16
type AttrTransferTypeConstraint ColorRedFieldInfo = (~)Word16
type AttrTransferType ColorRedFieldInfo = Word16
type AttrGetType ColorRedFieldInfo = Word16
type AttrLabel ColorRedFieldInfo = "red"
type AttrOrigin ColorRedFieldInfo = Color
attrGet = getColorRed
attrSet = setColorRed
attrConstruct = undefined
attrClear = undefined
attrTransfer _ v = do
return v
color_red :: AttrLabelProxy "red"
color_red = AttrLabelProxy
#endif
getColorGreen :: MonadIO m => Color -> m Word16
getColorGreen s = liftIO $ withManagedPtr s $ \ptr -> do
val <- peek (ptr `plusPtr` 2) :: IO Word16
return val
setColorGreen :: MonadIO m => Color -> Word16 -> m ()
setColorGreen s val = liftIO $ withManagedPtr s $ \ptr -> do
poke (ptr `plusPtr` 2) (val :: Word16)
#if defined(ENABLE_OVERLOADING)
data ColorGreenFieldInfo
instance AttrInfo ColorGreenFieldInfo where
type AttrBaseTypeConstraint ColorGreenFieldInfo = (~) Color
type AttrAllowedOps ColorGreenFieldInfo = '[ 'AttrSet, 'AttrGet]
type AttrSetTypeConstraint ColorGreenFieldInfo = (~) Word16
type AttrTransferTypeConstraint ColorGreenFieldInfo = (~)Word16
type AttrTransferType ColorGreenFieldInfo = Word16
type AttrGetType ColorGreenFieldInfo = Word16
type AttrLabel ColorGreenFieldInfo = "green"
type AttrOrigin ColorGreenFieldInfo = Color
attrGet = getColorGreen
attrSet = setColorGreen
attrConstruct = undefined
attrClear = undefined
attrTransfer _ v = do
return v
color_green :: AttrLabelProxy "green"
color_green = AttrLabelProxy
#endif
getColorBlue :: MonadIO m => Color -> m Word16
getColorBlue s = liftIO $ withManagedPtr s $ \ptr -> do
val <- peek (ptr `plusPtr` 4) :: IO Word16
return val
setColorBlue :: MonadIO m => Color -> Word16 -> m ()
setColorBlue s val = liftIO $ withManagedPtr s $ \ptr -> do
poke (ptr `plusPtr` 4) (val :: Word16)
#if defined(ENABLE_OVERLOADING)
data ColorBlueFieldInfo
instance AttrInfo ColorBlueFieldInfo where
type AttrBaseTypeConstraint ColorBlueFieldInfo = (~) Color
type AttrAllowedOps ColorBlueFieldInfo = '[ 'AttrSet, 'AttrGet]
type AttrSetTypeConstraint ColorBlueFieldInfo = (~) Word16
type AttrTransferTypeConstraint ColorBlueFieldInfo = (~)Word16
type AttrTransferType ColorBlueFieldInfo = Word16
type AttrGetType ColorBlueFieldInfo = Word16
type AttrLabel ColorBlueFieldInfo = "blue"
type AttrOrigin ColorBlueFieldInfo = Color
attrGet = getColorBlue
attrSet = setColorBlue
attrConstruct = undefined
attrClear = undefined
attrTransfer _ v = do
return v
color_blue :: AttrLabelProxy "blue"
color_blue = AttrLabelProxy
#endif
#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Color
type instance O.AttributeList Color = ColorAttributeList
type ColorAttributeList = ('[ '("red", ColorRedFieldInfo), '("green", ColorGreenFieldInfo), '("blue", ColorBlueFieldInfo)] :: [(Symbol, *)])
#endif
foreign import ccall "pango_color_copy" pango_color_copy ::
Ptr Color ->
IO (Ptr Color)
colorCopy ::
(B.CallStack.HasCallStack, MonadIO m) =>
Color
-> m (Maybe Color)
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 defined(ENABLE_OVERLOADING)
data ColorCopyMethodInfo
instance (signature ~ (m (Maybe Color)), MonadIO m) => O.MethodInfo ColorCopyMethodInfo Color signature where
overloadedMethod = colorCopy
#endif
foreign import ccall "pango_color_free" pango_color_free ::
Ptr Color ->
IO ()
colorFree ::
(B.CallStack.HasCallStack, MonadIO m) =>
Color
-> m ()
colorFree color = liftIO $ do
color' <- unsafeManagedPtrGetPtr color
pango_color_free color'
touchManagedPtr color
return ()
#if defined(ENABLE_OVERLOADING)
data ColorFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo ColorFreeMethodInfo Color signature where
overloadedMethod = colorFree
#endif
foreign import ccall "pango_color_parse" pango_color_parse ::
Ptr Color ->
CString ->
IO CInt
colorParse ::
(B.CallStack.HasCallStack, MonadIO m) =>
Color
-> T.Text
-> m Bool
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 defined(ENABLE_OVERLOADING)
data ColorParseMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m) => O.MethodInfo ColorParseMethodInfo Color signature where
overloadedMethod = colorParse
#endif
foreign import ccall "pango_color_to_string" pango_color_to_string ::
Ptr Color ->
IO CString
colorToString ::
(B.CallStack.HasCallStack, MonadIO m) =>
Color
-> m T.Text
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 defined(ENABLE_OVERLOADING)
data ColorToStringMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo ColorToStringMethodInfo Color signature where
overloadedMethod = colorToString
#endif
#if defined(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 @info
#else
fromLabel _ = O.overloadedMethod @info
#endif
#endif