module GI.Gdk.Structs.Color
(
Color(..) ,
newZeroColor ,
noColor ,
ColorCopyMethodInfo ,
colorCopy ,
ColorEqualMethodInfo ,
colorEqual ,
ColorFreeMethodInfo ,
colorFree ,
ColorHashMethodInfo ,
colorHash ,
colorParse ,
ColorToStringMethodInfo ,
colorToString ,
color_blue ,
getColorBlue ,
setColorBlue ,
color_green ,
getColorGreen ,
setColorGreen ,
color_pixel ,
getColorPixel ,
setColorPixel ,
color_red ,
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.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
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
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
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
noColor :: Maybe Color
noColor = Nothing
getColorPixel :: MonadIO m => Color -> m Word32
getColorPixel s = liftIO $ withManagedPtr s $ \ptr -> do
val <- peek (ptr `plusPtr` 0) :: IO Word32
return val
setColorPixel :: MonadIO m => Color -> Word32 -> m ()
setColorPixel s val = liftIO $ withManagedPtr s $ \ptr -> do
poke (ptr `plusPtr` 0) (val :: Word32)
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
getColorRed :: MonadIO m => Color -> m Word16
getColorRed s = liftIO $ withManagedPtr s $ \ptr -> do
val <- peek (ptr `plusPtr` 4) :: IO Word16
return val
setColorRed :: MonadIO m => Color -> Word16 -> m ()
setColorRed s val = liftIO $ withManagedPtr s $ \ptr -> do
poke (ptr `plusPtr` 4) (val :: Word16)
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
getColorGreen :: MonadIO m => Color -> m Word16
getColorGreen s = liftIO $ withManagedPtr s $ \ptr -> do
val <- peek (ptr `plusPtr` 6) :: IO Word16
return val
setColorGreen :: MonadIO m => Color -> Word16 -> m ()
setColorGreen s val = liftIO $ withManagedPtr s $ \ptr -> do
poke (ptr `plusPtr` 6) (val :: Word16)
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
getColorBlue :: MonadIO m => Color -> m Word16
getColorBlue s = liftIO $ withManagedPtr s $ \ptr -> do
val <- peek (ptr `plusPtr` 8) :: IO Word16
return val
setColorBlue :: MonadIO m => Color -> Word16 -> m ()
setColorBlue s val = liftIO $ withManagedPtr s $ \ptr -> do
poke (ptr `plusPtr` 8) (val :: Word16)
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
instance O.HasAttributeList Color
type instance O.AttributeList Color = ColorAttributeList
type ColorAttributeList = ('[ '("pixel", ColorPixelFieldInfo), '("red", ColorRedFieldInfo), '("green", ColorGreenFieldInfo), '("blue", ColorBlueFieldInfo)] :: [(Symbol, *)])
foreign import ccall "gdk_color_copy" gdk_color_copy ::
Ptr Color ->
IO (Ptr Color)
colorCopy ::
(B.CallStack.HasCallStack, MonadIO m) =>
Color
-> m Color
colorCopy color = liftIO $ do
color' <- unsafeManagedPtrGetPtr color
result <- gdk_color_copy color'
checkUnexpectedReturnNULL "colorCopy" result
result' <- (wrapBoxed Color) result
touchManagedPtr color
return result'
data ColorCopyMethodInfo
instance (signature ~ (m Color), MonadIO m) => O.MethodInfo ColorCopyMethodInfo Color signature where
overloadedMethod _ = colorCopy
foreign import ccall "gdk_color_equal" gdk_color_equal ::
Ptr Color ->
Ptr Color ->
IO CInt
colorEqual ::
(B.CallStack.HasCallStack, MonadIO m) =>
Color
-> Color
-> m Bool
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'
data ColorEqualMethodInfo
instance (signature ~ (Color -> m Bool), MonadIO m) => O.MethodInfo ColorEqualMethodInfo Color signature where
overloadedMethod _ = colorEqual
foreign import ccall "gdk_color_free" gdk_color_free ::
Ptr Color ->
IO ()
colorFree ::
(B.CallStack.HasCallStack, MonadIO m) =>
Color
-> m ()
colorFree color = liftIO $ do
color' <- unsafeManagedPtrGetPtr color
gdk_color_free color'
touchManagedPtr color
return ()
data ColorFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo ColorFreeMethodInfo Color signature where
overloadedMethod _ = colorFree
foreign import ccall "gdk_color_hash" gdk_color_hash ::
Ptr Color ->
IO Word32
colorHash ::
(B.CallStack.HasCallStack, MonadIO m) =>
Color
-> m Word32
colorHash color = liftIO $ do
color' <- unsafeManagedPtrGetPtr color
result <- gdk_color_hash color'
touchManagedPtr color
return result
data ColorHashMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.MethodInfo ColorHashMethodInfo Color signature where
overloadedMethod _ = colorHash
foreign import ccall "gdk_color_to_string" gdk_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 <- gdk_color_to_string color'
checkUnexpectedReturnNULL "colorToString" result
result' <- cstringToText result
freeMem result
touchManagedPtr color
return result'
data ColorToStringMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo ColorToStringMethodInfo Color signature where
overloadedMethod _ = colorToString
foreign import ccall "gdk_color_parse" gdk_color_parse ::
CString ->
Ptr Color ->
IO CInt
colorParse ::
(B.CallStack.HasCallStack, MonadIO m) =>
T.Text
-> m (Bool,Color)
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')
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) => O.IsLabelProxy t (Color -> p) where
fromLabelProxy _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)
#if MIN_VERSION_base(4,9,0)
instance (info ~ ResolveColorMethod t Color, O.MethodInfo info Color p) => O.IsLabel t (Color -> p) where
fromLabel _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)
#endif