{-# LANGUAGE TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.Dazzle.Objects.GraphLineRenderer
(
#if defined(ENABLE_OVERLOADING)
GraphLineRendererGetStrokeColorRgbaMethodInfo,
#endif
GraphLineRenderer(..) ,
IsGraphLineRenderer ,
toGraphLineRenderer ,
#if defined(ENABLE_OVERLOADING)
ResolveGraphLineRendererMethod ,
#endif
graphLineRendererNew ,
#if defined(ENABLE_OVERLOADING)
GraphLineRendererSetStrokeColorMethodInfo,
#endif
graphLineRendererSetStrokeColor ,
#if defined(ENABLE_OVERLOADING)
GraphLineRendererSetStrokeColorRgbaMethodInfo,
#endif
graphLineRendererSetStrokeColorRgba ,
#if defined(ENABLE_OVERLOADING)
GraphLineRendererColumnPropertyInfo ,
#endif
constructGraphLineRendererColumn ,
getGraphLineRendererColumn ,
#if defined(ENABLE_OVERLOADING)
graphLineRendererColumn ,
#endif
setGraphLineRendererColumn ,
#if defined(ENABLE_OVERLOADING)
GraphLineRendererLineWidthPropertyInfo ,
#endif
constructGraphLineRendererLineWidth ,
getGraphLineRendererLineWidth ,
#if defined(ENABLE_OVERLOADING)
graphLineRendererLineWidth ,
#endif
setGraphLineRendererLineWidth ,
#if defined(ENABLE_OVERLOADING)
GraphLineRendererStrokeColorPropertyInfo,
#endif
constructGraphLineRendererStrokeColor ,
getGraphLineRendererStrokeColor ,
#if defined(ENABLE_OVERLOADING)
graphLineRendererStrokeColor ,
#endif
setGraphLineRendererStrokeColor ,
#if defined(ENABLE_OVERLOADING)
GraphLineRendererStrokeColorRgbaPropertyInfo,
#endif
constructGraphLineRendererStrokeColorRgba,
getGraphLineRendererStrokeColorRgba ,
#if defined(ENABLE_OVERLOADING)
graphLineRendererStrokeColorRgba ,
#endif
setGraphLineRendererStrokeColorRgba ,
) 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.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
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 Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
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
import qualified GHC.Records as R
import qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT
#if MIN_VERSION_base(4,18,0)
import qualified GI.Cairo.Structs.Context as Cairo.Context
import qualified GI.Cairo.Structs.RectangleInt as Cairo.RectangleInt
import {-# SOURCE #-} qualified GI.Dazzle.Interfaces.GraphRenderer as Dazzle.GraphRenderer
import {-# SOURCE #-} qualified GI.Dazzle.Objects.GraphColumn as Dazzle.GraphColumn
import {-# SOURCE #-} qualified GI.Dazzle.Objects.GraphModel as Dazzle.GraphModel
import {-# SOURCE #-} qualified GI.Dazzle.Structs.GraphModelIter as Dazzle.GraphModelIter
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Structs.RGBA as Gdk.RGBA
#else
import {-# SOURCE #-} qualified GI.Dazzle.Interfaces.GraphRenderer as Dazzle.GraphRenderer
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Structs.RGBA as Gdk.RGBA
#endif
newtype GraphLineRenderer = GraphLineRenderer (SP.ManagedPtr GraphLineRenderer)
deriving (GraphLineRenderer -> GraphLineRenderer -> Bool
(GraphLineRenderer -> GraphLineRenderer -> Bool)
-> (GraphLineRenderer -> GraphLineRenderer -> Bool)
-> Eq GraphLineRenderer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GraphLineRenderer -> GraphLineRenderer -> Bool
== :: GraphLineRenderer -> GraphLineRenderer -> Bool
$c/= :: GraphLineRenderer -> GraphLineRenderer -> Bool
/= :: GraphLineRenderer -> GraphLineRenderer -> Bool
Eq)
instance SP.ManagedPtrNewtype GraphLineRenderer where
toManagedPtr :: GraphLineRenderer -> ManagedPtr GraphLineRenderer
toManagedPtr (GraphLineRenderer ManagedPtr GraphLineRenderer
p) = ManagedPtr GraphLineRenderer
p
foreign import ccall "dzl_graph_view_line_renderer_get_type"
c_dzl_graph_view_line_renderer_get_type :: IO B.Types.GType
instance B.Types.TypedObject GraphLineRenderer where
glibType :: IO GType
glibType = IO GType
c_dzl_graph_view_line_renderer_get_type
instance B.Types.GObject GraphLineRenderer
class (SP.GObject o, O.IsDescendantOf GraphLineRenderer o) => IsGraphLineRenderer o
instance (SP.GObject o, O.IsDescendantOf GraphLineRenderer o) => IsGraphLineRenderer o
instance O.HasParentTypes GraphLineRenderer
type instance O.ParentTypes GraphLineRenderer = '[GObject.Object.Object, Dazzle.GraphRenderer.GraphRenderer]
toGraphLineRenderer :: (MIO.MonadIO m, IsGraphLineRenderer o) => o -> m GraphLineRenderer
toGraphLineRenderer :: forall (m :: * -> *) o.
(MonadIO m, IsGraphLineRenderer o) =>
o -> m GraphLineRenderer
toGraphLineRenderer = IO GraphLineRenderer -> m GraphLineRenderer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO GraphLineRenderer -> m GraphLineRenderer)
-> (o -> IO GraphLineRenderer) -> o -> m GraphLineRenderer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr GraphLineRenderer -> GraphLineRenderer)
-> o -> IO GraphLineRenderer
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr GraphLineRenderer -> GraphLineRenderer
GraphLineRenderer
instance B.GValue.IsGValue (Maybe GraphLineRenderer) where
gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_dzl_graph_view_line_renderer_get_type
gvalueSet_ :: Ptr GValue -> Maybe GraphLineRenderer -> IO ()
gvalueSet_ Ptr GValue
gv Maybe GraphLineRenderer
P.Nothing = Ptr GValue -> Ptr GraphLineRenderer -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr GraphLineRenderer
forall a. Ptr a
FP.nullPtr :: FP.Ptr GraphLineRenderer)
gvalueSet_ Ptr GValue
gv (P.Just GraphLineRenderer
obj) = GraphLineRenderer -> (Ptr GraphLineRenderer -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr GraphLineRenderer
obj (Ptr GValue -> Ptr GraphLineRenderer -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
gvalueGet_ :: Ptr GValue -> IO (Maybe GraphLineRenderer)
gvalueGet_ Ptr GValue
gv = do
Ptr GraphLineRenderer
ptr <- Ptr GValue -> IO (Ptr GraphLineRenderer)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr GraphLineRenderer)
if Ptr GraphLineRenderer
ptr Ptr GraphLineRenderer -> Ptr GraphLineRenderer -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr GraphLineRenderer
forall a. Ptr a
FP.nullPtr
then GraphLineRenderer -> Maybe GraphLineRenderer
forall a. a -> Maybe a
P.Just (GraphLineRenderer -> Maybe GraphLineRenderer)
-> IO GraphLineRenderer -> IO (Maybe GraphLineRenderer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr GraphLineRenderer -> GraphLineRenderer)
-> Ptr GraphLineRenderer -> IO GraphLineRenderer
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr GraphLineRenderer -> GraphLineRenderer
GraphLineRenderer Ptr GraphLineRenderer
ptr
else Maybe GraphLineRenderer -> IO (Maybe GraphLineRenderer)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GraphLineRenderer
forall a. Maybe a
P.Nothing
#if defined(ENABLE_OVERLOADING)
type family ResolveGraphLineRendererMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
ResolveGraphLineRendererMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
ResolveGraphLineRendererMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
ResolveGraphLineRendererMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
ResolveGraphLineRendererMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
ResolveGraphLineRendererMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
ResolveGraphLineRendererMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
ResolveGraphLineRendererMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
ResolveGraphLineRendererMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
ResolveGraphLineRendererMethod "ref" o = GObject.Object.ObjectRefMethodInfo
ResolveGraphLineRendererMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
ResolveGraphLineRendererMethod "render" o = Dazzle.GraphRenderer.GraphRendererRenderMethodInfo
ResolveGraphLineRendererMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
ResolveGraphLineRendererMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
ResolveGraphLineRendererMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
ResolveGraphLineRendererMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
ResolveGraphLineRendererMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
ResolveGraphLineRendererMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
ResolveGraphLineRendererMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
ResolveGraphLineRendererMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
ResolveGraphLineRendererMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
ResolveGraphLineRendererMethod "getStrokeColorRgba" o = GraphLineRendererGetStrokeColorRgbaMethodInfo
ResolveGraphLineRendererMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
ResolveGraphLineRendererMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
ResolveGraphLineRendererMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
ResolveGraphLineRendererMethod "setStrokeColor" o = GraphLineRendererSetStrokeColorMethodInfo
ResolveGraphLineRendererMethod "setStrokeColorRgba" o = GraphLineRendererSetStrokeColorRgbaMethodInfo
ResolveGraphLineRendererMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveGraphLineRendererMethod t GraphLineRenderer, O.OverloadedMethod info GraphLineRenderer p) => OL.IsLabel t (GraphLineRenderer -> p) where
#if MIN_VERSION_base(4,10,0)
fromLabel = O.overloadedMethod @info
#else
fromLabel _ = O.overloadedMethod @info
#endif
#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveGraphLineRendererMethod t GraphLineRenderer, O.OverloadedMethod info GraphLineRenderer p, R.HasField t GraphLineRenderer p) => R.HasField t GraphLineRenderer p where
getField = O.overloadedMethod @info
#endif
instance (info ~ ResolveGraphLineRendererMethod t GraphLineRenderer, O.OverloadedMethodInfo info GraphLineRenderer) => OL.IsLabel t (O.MethodProxy info GraphLineRenderer) where
#if MIN_VERSION_base(4,10,0)
fromLabel = O.MethodProxy
#else
fromLabel _ = O.MethodProxy
#endif
#endif
getGraphLineRendererColumn :: (MonadIO m, IsGraphLineRenderer o) => o -> m Word32
getGraphLineRendererColumn :: forall (m :: * -> *) o.
(MonadIO m, IsGraphLineRenderer o) =>
o -> m Word32
getGraphLineRendererColumn o
obj = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"column"
setGraphLineRendererColumn :: (MonadIO m, IsGraphLineRenderer o) => o -> Word32 -> m ()
setGraphLineRendererColumn :: forall (m :: * -> *) o.
(MonadIO m, IsGraphLineRenderer o) =>
o -> Word32 -> m ()
setGraphLineRendererColumn o
obj Word32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> Word32 -> IO ()
forall a. GObject a => a -> String -> Word32 -> IO ()
B.Properties.setObjectPropertyUInt32 o
obj String
"column" Word32
val
constructGraphLineRendererColumn :: (IsGraphLineRenderer o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructGraphLineRendererColumn :: forall o (m :: * -> *).
(IsGraphLineRenderer o, MonadIO m) =>
Word32 -> m (GValueConstruct o)
constructGraphLineRendererColumn Word32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"column" Word32
val
#if defined(ENABLE_OVERLOADING)
data GraphLineRendererColumnPropertyInfo
instance AttrInfo GraphLineRendererColumnPropertyInfo where
type AttrAllowedOps GraphLineRendererColumnPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint GraphLineRendererColumnPropertyInfo = IsGraphLineRenderer
type AttrSetTypeConstraint GraphLineRendererColumnPropertyInfo = (~) Word32
type AttrTransferTypeConstraint GraphLineRendererColumnPropertyInfo = (~) Word32
type AttrTransferType GraphLineRendererColumnPropertyInfo = Word32
type AttrGetType GraphLineRendererColumnPropertyInfo = Word32
type AttrLabel GraphLineRendererColumnPropertyInfo = "column"
type AttrOrigin GraphLineRendererColumnPropertyInfo = GraphLineRenderer
attrGet = getGraphLineRendererColumn
attrSet = setGraphLineRendererColumn
attrTransfer _ v = do
return v
attrConstruct = constructGraphLineRendererColumn
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.GraphLineRenderer.column"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-GraphLineRenderer.html#g:attr:column"
})
#endif
getGraphLineRendererLineWidth :: (MonadIO m, IsGraphLineRenderer o) => o -> m Double
getGraphLineRendererLineWidth :: forall (m :: * -> *) o.
(MonadIO m, IsGraphLineRenderer o) =>
o -> m Double
getGraphLineRendererLineWidth o
obj = IO Double -> m Double
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Double
forall a. GObject a => a -> String -> IO Double
B.Properties.getObjectPropertyDouble o
obj String
"line-width"
setGraphLineRendererLineWidth :: (MonadIO m, IsGraphLineRenderer o) => o -> Double -> m ()
setGraphLineRendererLineWidth :: forall (m :: * -> *) o.
(MonadIO m, IsGraphLineRenderer o) =>
o -> Double -> m ()
setGraphLineRendererLineWidth o
obj Double
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> Double -> IO ()
forall a. GObject a => a -> String -> Double -> IO ()
B.Properties.setObjectPropertyDouble o
obj String
"line-width" Double
val
constructGraphLineRendererLineWidth :: (IsGraphLineRenderer o, MIO.MonadIO m) => Double -> m (GValueConstruct o)
constructGraphLineRendererLineWidth :: forall o (m :: * -> *).
(IsGraphLineRenderer o, MonadIO m) =>
Double -> m (GValueConstruct o)
constructGraphLineRendererLineWidth Double
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Double -> IO (GValueConstruct o)
forall o. String -> Double -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyDouble String
"line-width" Double
val
#if defined(ENABLE_OVERLOADING)
data GraphLineRendererLineWidthPropertyInfo
instance AttrInfo GraphLineRendererLineWidthPropertyInfo where
type AttrAllowedOps GraphLineRendererLineWidthPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint GraphLineRendererLineWidthPropertyInfo = IsGraphLineRenderer
type AttrSetTypeConstraint GraphLineRendererLineWidthPropertyInfo = (~) Double
type AttrTransferTypeConstraint GraphLineRendererLineWidthPropertyInfo = (~) Double
type AttrTransferType GraphLineRendererLineWidthPropertyInfo = Double
type AttrGetType GraphLineRendererLineWidthPropertyInfo = Double
type AttrLabel GraphLineRendererLineWidthPropertyInfo = "line-width"
type AttrOrigin GraphLineRendererLineWidthPropertyInfo = GraphLineRenderer
attrGet = getGraphLineRendererLineWidth
attrSet = setGraphLineRendererLineWidth
attrTransfer _ v = do
return v
attrConstruct = constructGraphLineRendererLineWidth
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.GraphLineRenderer.lineWidth"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-GraphLineRenderer.html#g:attr:lineWidth"
})
#endif
getGraphLineRendererStrokeColor :: (MonadIO m, IsGraphLineRenderer o) => o -> m (Maybe T.Text)
getGraphLineRendererStrokeColor :: forall (m :: * -> *) o.
(MonadIO m, IsGraphLineRenderer o) =>
o -> m (Maybe Text)
getGraphLineRendererStrokeColor o
obj = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"stroke-color"
setGraphLineRendererStrokeColor :: (MonadIO m, IsGraphLineRenderer o) => o -> T.Text -> m ()
setGraphLineRendererStrokeColor :: forall (m :: * -> *) o.
(MonadIO m, IsGraphLineRenderer o) =>
o -> Text -> m ()
setGraphLineRendererStrokeColor o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"stroke-color" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)
constructGraphLineRendererStrokeColor :: (IsGraphLineRenderer o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructGraphLineRendererStrokeColor :: forall o (m :: * -> *).
(IsGraphLineRenderer o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructGraphLineRendererStrokeColor Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"stroke-color" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)
#if defined(ENABLE_OVERLOADING)
data GraphLineRendererStrokeColorPropertyInfo
instance AttrInfo GraphLineRendererStrokeColorPropertyInfo where
type AttrAllowedOps GraphLineRendererStrokeColorPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint GraphLineRendererStrokeColorPropertyInfo = IsGraphLineRenderer
type AttrSetTypeConstraint GraphLineRendererStrokeColorPropertyInfo = (~) T.Text
type AttrTransferTypeConstraint GraphLineRendererStrokeColorPropertyInfo = (~) T.Text
type AttrTransferType GraphLineRendererStrokeColorPropertyInfo = T.Text
type AttrGetType GraphLineRendererStrokeColorPropertyInfo = (Maybe T.Text)
type AttrLabel GraphLineRendererStrokeColorPropertyInfo = "stroke-color"
type AttrOrigin GraphLineRendererStrokeColorPropertyInfo = GraphLineRenderer
attrGet = getGraphLineRendererStrokeColor
attrSet = setGraphLineRendererStrokeColor
attrTransfer _ v = do
return v
attrConstruct = constructGraphLineRendererStrokeColor
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.GraphLineRenderer.strokeColor"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-GraphLineRenderer.html#g:attr:strokeColor"
})
#endif
getGraphLineRendererStrokeColorRgba :: (MonadIO m, IsGraphLineRenderer o) => o -> m Gdk.RGBA.RGBA
getGraphLineRendererStrokeColorRgba :: forall (m :: * -> *) o.
(MonadIO m, IsGraphLineRenderer o) =>
o -> m RGBA
getGraphLineRendererStrokeColorRgba o
obj = IO RGBA -> m RGBA
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO RGBA -> m RGBA) -> IO RGBA -> m RGBA
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe RGBA) -> IO RGBA
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getGraphLineRendererStrokeColorRgba" (IO (Maybe RGBA) -> IO RGBA) -> IO (Maybe RGBA) -> IO RGBA
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr RGBA -> RGBA) -> IO (Maybe RGBA)
forall a b.
(GObject a, GBoxed b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyBoxed o
obj String
"stroke-color-rgba" ManagedPtr RGBA -> RGBA
Gdk.RGBA.RGBA
setGraphLineRendererStrokeColorRgba :: (MonadIO m, IsGraphLineRenderer o) => o -> Gdk.RGBA.RGBA -> m ()
setGraphLineRendererStrokeColorRgba :: forall (m :: * -> *) o.
(MonadIO m, IsGraphLineRenderer o) =>
o -> RGBA -> m ()
setGraphLineRendererStrokeColorRgba o
obj RGBA
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> Maybe RGBA -> IO ()
forall a b.
(GObject a, GBoxed b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyBoxed o
obj String
"stroke-color-rgba" (RGBA -> Maybe RGBA
forall a. a -> Maybe a
Just RGBA
val)
constructGraphLineRendererStrokeColorRgba :: (IsGraphLineRenderer o, MIO.MonadIO m) => Gdk.RGBA.RGBA -> m (GValueConstruct o)
constructGraphLineRendererStrokeColorRgba :: forall o (m :: * -> *).
(IsGraphLineRenderer o, MonadIO m) =>
RGBA -> m (GValueConstruct o)
constructGraphLineRendererStrokeColorRgba RGBA
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe RGBA -> IO (GValueConstruct o)
forall a o. GBoxed a => String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBoxed String
"stroke-color-rgba" (RGBA -> Maybe RGBA
forall a. a -> Maybe a
P.Just RGBA
val)
#if defined(ENABLE_OVERLOADING)
data GraphLineRendererStrokeColorRgbaPropertyInfo
instance AttrInfo GraphLineRendererStrokeColorRgbaPropertyInfo where
type AttrAllowedOps GraphLineRendererStrokeColorRgbaPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint GraphLineRendererStrokeColorRgbaPropertyInfo = IsGraphLineRenderer
type AttrSetTypeConstraint GraphLineRendererStrokeColorRgbaPropertyInfo = (~) Gdk.RGBA.RGBA
type AttrTransferTypeConstraint GraphLineRendererStrokeColorRgbaPropertyInfo = (~) Gdk.RGBA.RGBA
type AttrTransferType GraphLineRendererStrokeColorRgbaPropertyInfo = Gdk.RGBA.RGBA
type AttrGetType GraphLineRendererStrokeColorRgbaPropertyInfo = Gdk.RGBA.RGBA
type AttrLabel GraphLineRendererStrokeColorRgbaPropertyInfo = "stroke-color-rgba"
type AttrOrigin GraphLineRendererStrokeColorRgbaPropertyInfo = GraphLineRenderer
attrGet = getGraphLineRendererStrokeColorRgba
attrSet = setGraphLineRendererStrokeColorRgba
attrTransfer _ v = do
return v
attrConstruct = constructGraphLineRendererStrokeColorRgba
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.GraphLineRenderer.strokeColorRgba"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-GraphLineRenderer.html#g:attr:strokeColorRgba"
})
#endif
#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList GraphLineRenderer
type instance O.AttributeList GraphLineRenderer = GraphLineRendererAttributeList
type GraphLineRendererAttributeList = ('[ '("column", GraphLineRendererColumnPropertyInfo), '("lineWidth", GraphLineRendererLineWidthPropertyInfo), '("strokeColor", GraphLineRendererStrokeColorPropertyInfo), '("strokeColorRgba", GraphLineRendererStrokeColorRgbaPropertyInfo)] :: [(Symbol, DK.Type)])
#endif
#if defined(ENABLE_OVERLOADING)
graphLineRendererColumn :: AttrLabelProxy "column"
graphLineRendererColumn = AttrLabelProxy
graphLineRendererLineWidth :: AttrLabelProxy "lineWidth"
graphLineRendererLineWidth = AttrLabelProxy
graphLineRendererStrokeColor :: AttrLabelProxy "strokeColor"
graphLineRendererStrokeColor = AttrLabelProxy
graphLineRendererStrokeColorRgba :: AttrLabelProxy "strokeColorRgba"
graphLineRendererStrokeColorRgba = AttrLabelProxy
#endif
#if defined(ENABLE_OVERLOADING)
type instance O.SignalList GraphLineRenderer = GraphLineRendererSignalList
type GraphLineRendererSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])
#endif
foreign import ccall "dzl_graph_view_line_renderer_new" dzl_graph_view_line_renderer_new ::
IO (Ptr GraphLineRenderer)
graphLineRendererNew ::
(B.CallStack.HasCallStack, MonadIO m) =>
m GraphLineRenderer
graphLineRendererNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
m GraphLineRenderer
graphLineRendererNew = IO GraphLineRenderer -> m GraphLineRenderer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GraphLineRenderer -> m GraphLineRenderer)
-> IO GraphLineRenderer -> m GraphLineRenderer
forall a b. (a -> b) -> a -> b
$ do
Ptr GraphLineRenderer
result <- IO (Ptr GraphLineRenderer)
dzl_graph_view_line_renderer_new
Text -> Ptr GraphLineRenderer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"graphLineRendererNew" Ptr GraphLineRenderer
result
GraphLineRenderer
result' <- ((ManagedPtr GraphLineRenderer -> GraphLineRenderer)
-> Ptr GraphLineRenderer -> IO GraphLineRenderer
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr GraphLineRenderer -> GraphLineRenderer
GraphLineRenderer) Ptr GraphLineRenderer
result
GraphLineRenderer -> IO GraphLineRenderer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GraphLineRenderer
result'
#if defined(ENABLE_OVERLOADING)
#endif
#if defined(ENABLE_OVERLOADING)
data GraphLineRendererGetStrokeColorRgbaMethodInfo
instance (p ~ (), o ~ O.UnsupportedMethodError "getStrokeColorRgba" GraphLineRenderer) => O.OverloadedMethod GraphLineRendererGetStrokeColorRgbaMethodInfo o p where
overloadedMethod = undefined
instance (o ~ O.UnsupportedMethodError "getStrokeColorRgba" GraphLineRenderer) => O.OverloadedMethodInfo GraphLineRendererGetStrokeColorRgbaMethodInfo o where
overloadedMethodInfo = undefined
#endif
foreign import ccall "dzl_graph_view_line_renderer_set_stroke_color" dzl_graph_view_line_renderer_set_stroke_color ::
Ptr GraphLineRenderer ->
CString ->
IO ()
graphLineRendererSetStrokeColor ::
(B.CallStack.HasCallStack, MonadIO m, IsGraphLineRenderer a) =>
a
-> T.Text
-> m ()
graphLineRendererSetStrokeColor :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsGraphLineRenderer a) =>
a -> Text -> m ()
graphLineRendererSetStrokeColor a
self Text
strokeColor = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr GraphLineRenderer
self' <- a -> IO (Ptr GraphLineRenderer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
CString
strokeColor' <- Text -> IO CString
textToCString Text
strokeColor
Ptr GraphLineRenderer -> CString -> IO ()
dzl_graph_view_line_renderer_set_stroke_color Ptr GraphLineRenderer
self' CString
strokeColor'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
strokeColor'
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data GraphLineRendererSetStrokeColorMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsGraphLineRenderer a) => O.OverloadedMethod GraphLineRendererSetStrokeColorMethodInfo a signature where
overloadedMethod = graphLineRendererSetStrokeColor
instance O.OverloadedMethodInfo GraphLineRendererSetStrokeColorMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.GraphLineRenderer.graphLineRendererSetStrokeColor",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-GraphLineRenderer.html#v:graphLineRendererSetStrokeColor"
})
#endif
foreign import ccall "dzl_graph_view_line_renderer_set_stroke_color_rgba" dzl_graph_view_line_renderer_set_stroke_color_rgba ::
Ptr GraphLineRenderer ->
Ptr Gdk.RGBA.RGBA ->
IO ()
graphLineRendererSetStrokeColorRgba ::
(B.CallStack.HasCallStack, MonadIO m, IsGraphLineRenderer a) =>
a
-> Gdk.RGBA.RGBA
-> m ()
graphLineRendererSetStrokeColorRgba :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsGraphLineRenderer a) =>
a -> RGBA -> m ()
graphLineRendererSetStrokeColorRgba a
self RGBA
strokeColorRgba = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr GraphLineRenderer
self' <- a -> IO (Ptr GraphLineRenderer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
Ptr RGBA
strokeColorRgba' <- RGBA -> IO (Ptr RGBA)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RGBA
strokeColorRgba
Ptr GraphLineRenderer -> Ptr RGBA -> IO ()
dzl_graph_view_line_renderer_set_stroke_color_rgba Ptr GraphLineRenderer
self' Ptr RGBA
strokeColorRgba'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
RGBA -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RGBA
strokeColorRgba
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data GraphLineRendererSetStrokeColorRgbaMethodInfo
instance (signature ~ (Gdk.RGBA.RGBA -> m ()), MonadIO m, IsGraphLineRenderer a) => O.OverloadedMethod GraphLineRendererSetStrokeColorRgbaMethodInfo a signature where
overloadedMethod = graphLineRendererSetStrokeColorRgba
instance O.OverloadedMethodInfo GraphLineRendererSetStrokeColorRgbaMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.GraphLineRenderer.graphLineRendererSetStrokeColorRgba",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-GraphLineRenderer.html#v:graphLineRendererSetStrokeColorRgba"
})
#endif