{-# LANGUAGE ScopedTypeVariables #-}
-- | This is a graph widget inspired by the widget of the same name in Awesome
-- (the window manager). It plots a series of data points similarly to a bar
-- graph. This version must be explicitly fed data with 'graphAddSample'. For a
-- more automated version, see "System.Taffybar.Widgets.Generic.PollingGraph".
--
-- Like Awesome, this graph can plot multiple data sets in one widget. The data
-- sets are plotted in the order provided by the caller.
--
-- Note: all of the data fed to this widget should be in the range [0,1].
module System.Taffybar.Widget.Generic.Graph (
  -- * Types
    GraphHandle
  , GraphConfig(..)
  , GraphDirection(..)
  , GraphStyle(..)
  -- * Functions
  , graphNew
  , graphAddSample
  , defaultGraphConfig
  ) where

import           Control.Concurrent
import           Control.Monad ( when )
import           Control.Monad.IO.Class
import           Data.Default ( Default(..) )
import           Data.Foldable ( mapM_ )
import           Data.Sequence ( Seq, (<|), viewl, ViewL(..) )
import qualified Data.Sequence as S
import qualified Data.Text as T
import qualified GI.Cairo.Render as C
import           GI.Cairo.Render.Connector
import qualified GI.Cairo.Render.Matrix as M
import qualified GI.Gtk as Gtk
import           Prelude hiding ( mapM_ )
import           System.Taffybar.Util
import           System.Taffybar.Widget.Util

newtype GraphHandle = GH (MVar GraphState)
data GraphState =
  GraphState { GraphState -> Bool
graphIsBootstrapped :: Bool
             , GraphState -> [Seq Double]
graphHistory :: [Seq Double]
             , GraphState -> DrawingArea
graphCanvas :: Gtk.DrawingArea
             , GraphState -> GraphConfig
graphConfig :: GraphConfig
             }

data GraphDirection = LEFT_TO_RIGHT | RIGHT_TO_LEFT deriving (GraphDirection -> GraphDirection -> Bool
(GraphDirection -> GraphDirection -> Bool)
-> (GraphDirection -> GraphDirection -> Bool) -> Eq GraphDirection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GraphDirection -> GraphDirection -> Bool
== :: GraphDirection -> GraphDirection -> Bool
$c/= :: GraphDirection -> GraphDirection -> Bool
/= :: GraphDirection -> GraphDirection -> Bool
Eq)

-- 'RGBA' represents a color with a transparency.
type RGBA = (Double, Double, Double, Double)

-- | The style of the graph. Generally, you will want to draw all 'Area' graphs
-- first, and then all 'Line' graphs.
data GraphStyle
    = Area -- ^ Thea area below the value is filled
    | Line -- ^ The values are connected by a line (one pixel wide)

-- | The configuration options for the graph. The padding is the number of
-- pixels reserved as blank space around the widget in each direction.
data GraphConfig = GraphConfig {
  -- | Number of pixels of padding on each side of the graph widget
    GraphConfig -> Int
graphPadding :: Int
  -- | The background color of the graph (default black)
  , GraphConfig -> RGBA
graphBackgroundColor :: RGBA
  -- | The border color drawn around the graph (default gray)
  , GraphConfig -> RGBA
graphBorderColor :: RGBA
  -- | The width of the border (default 1, use 0 to disable the border)
  , GraphConfig -> Int
graphBorderWidth :: Int
  -- | Colors for each data set (default cycles between red, green and blue)
  , GraphConfig -> [RGBA]
graphDataColors :: [RGBA]
  -- | How to draw each data point (default @repeat Area@)
  , GraphConfig -> [GraphStyle]
graphDataStyles :: [GraphStyle]
  -- | The number of data points to retain for each data set (default 20)
  , GraphConfig -> Int
graphHistorySize :: Int
  -- | May contain Pango markup (default @Nothing@)
  , GraphConfig -> Maybe Text
graphLabel :: Maybe T.Text
  -- | The width (in pixels) of the graph widget (default 50)
  , GraphConfig -> Int
graphWidth :: Int
  -- | The direction in which the graph will move as time passes (default LEFT_TO_RIGHT)
  , GraphConfig -> GraphDirection
graphDirection :: GraphDirection
  }

defaultGraphConfig :: GraphConfig
defaultGraphConfig :: GraphConfig
defaultGraphConfig =
  GraphConfig
  { graphPadding :: Int
graphPadding = Int
2
  , graphBackgroundColor :: RGBA
graphBackgroundColor = (Double
0.0, Double
0.0, Double
0.0, Double
1.0)
  , graphBorderColor :: RGBA
graphBorderColor = (Double
0.5, Double
0.5, Double
0.5, Double
1.0)
  , graphBorderWidth :: Int
graphBorderWidth = Int
1
  , graphDataColors :: [RGBA]
graphDataColors = [RGBA] -> [RGBA]
forall a. HasCallStack => [a] -> [a]
cycle [(Double
1, Double
0, Double
0, Double
0), (Double
0, Double
1, Double
0, Double
0), (Double
0, Double
0, Double
1, Double
0)]
  , graphDataStyles :: [GraphStyle]
graphDataStyles = GraphStyle -> [GraphStyle]
forall a. a -> [a]
repeat GraphStyle
Area
  , graphHistorySize :: Int
graphHistorySize = Int
20
  , graphLabel :: Maybe Text
graphLabel = Maybe Text
forall a. Maybe a
Nothing
  , graphWidth :: Int
graphWidth = Int
50
  , graphDirection :: GraphDirection
graphDirection = GraphDirection
LEFT_TO_RIGHT
  }

instance Default GraphConfig where
  def :: GraphConfig
def = GraphConfig
defaultGraphConfig

-- | Add a data point to the graph for each of the tracked data sets. There
-- should be as many values in the list as there are data sets.
graphAddSample :: GraphHandle -> [Double] -> IO ()
graphAddSample :: GraphHandle -> [Double] -> IO ()
graphAddSample (GH MVar GraphState
mv) [Double]
rawData = do
  GraphState
s <- MVar GraphState -> IO GraphState
forall a. MVar a -> IO a
readMVar MVar GraphState
mv
  let drawArea :: DrawingArea
drawArea = GraphState -> DrawingArea
graphCanvas GraphState
s
      histSize :: Int
histSize = GraphConfig -> Int
graphHistorySize (GraphState -> GraphConfig
graphConfig GraphState
s)
      histsAndNewVals :: [(Double, Seq Double)]
histsAndNewVals = [Double] -> [Seq Double] -> [(Double, Seq Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Double]
pcts (GraphState -> [Seq Double]
graphHistory GraphState
s)
      newHists :: [Seq Double]
newHists = case GraphState -> [Seq Double]
graphHistory GraphState
s of
        [] -> (Double -> Seq Double) -> [Double] -> [Seq Double]
forall a b. (a -> b) -> [a] -> [b]
map Double -> Seq Double
forall a. a -> Seq a
S.singleton [Double]
pcts
        [Seq Double]
_ -> ((Double, Seq Double) -> Seq Double)
-> [(Double, Seq Double)] -> [Seq Double]
forall a b. (a -> b) -> [a] -> [b]
map (\(Double
p,Seq Double
h) -> Int -> Seq Double -> Seq Double
forall a. Int -> Seq a -> Seq a
S.take Int
histSize (Seq Double -> Seq Double) -> Seq Double -> Seq Double
forall a b. (a -> b) -> a -> b
$ Double
p Double -> Seq Double -> Seq Double
forall a. a -> Seq a -> Seq a
<| Seq Double
h) [(Double, Seq Double)]
histsAndNewVals
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GraphState -> Bool
graphIsBootstrapped GraphState
s) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    MVar GraphState -> (GraphState -> IO GraphState) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar GraphState
mv (\GraphState
s' -> GraphState -> IO GraphState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GraphState
s' { graphHistory :: [Seq Double]
graphHistory = [Seq Double]
newHists })
    IO () -> IO ()
postGUIASync (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ DrawingArea -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ()
Gtk.widgetQueueDraw DrawingArea
drawArea
  where
    pcts :: [Double]
pcts = (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Double -> Double -> Double
clamp Double
0 Double
1) [Double]
rawData

clamp :: Double -> Double -> Double -> Double
clamp :: Double -> Double -> Double -> Double
clamp Double
lo Double
hi Double
d = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
lo (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
hi Double
d

outlineData :: (Double -> Double) -> Double -> Double -> C.Render ()
outlineData :: (Double -> Double) -> Double -> Double -> Render ()
outlineData Double -> Double
pctToY Double
xStep Double
pct = do
  (Double
curX,Double
_) <- Render (Double, Double)
C.getCurrentPoint
  Double -> Double -> Render ()
C.lineTo (Double
curX Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
xStep) (Double -> Double
pctToY Double
pct)

renderFrameAndBackground :: GraphConfig -> Int -> Int -> C.Render ()
renderFrameAndBackground :: GraphConfig -> Int -> Int -> Render ()
renderFrameAndBackground GraphConfig
cfg Int
w Int
h = do
  let (Double
backR, Double
backG, Double
backB, Double
backA) = GraphConfig -> RGBA
graphBackgroundColor GraphConfig
cfg
      (Double
frameR, Double
frameG, Double
frameB, Double
frameA) = GraphConfig -> RGBA
graphBorderColor GraphConfig
cfg
      pad :: Int
pad = GraphConfig -> Int
graphPadding GraphConfig
cfg
      fpad :: Double
fpad = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pad
      fw :: Double
fw = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w
      fh :: Double
fh = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h

  -- Draw the requested background
  Double -> Double -> Double -> Double -> Render ()
C.setSourceRGBA Double
backR Double
backG Double
backB Double
backA
  Double -> Double -> Double -> Double -> Render ()
C.rectangle Double
fpad Double
fpad (Double
fw Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
fpad) (Double
fh Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
fpad)
  Render ()
C.fill

  -- Draw a frame around the widget area (unless equal to background color,
  -- which likely means the user does not want a frame)
  Bool -> Render () -> Render ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GraphConfig -> Int
graphBorderWidth GraphConfig
cfg Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Render () -> Render ()) -> Render () -> Render ()
forall a b. (a -> b) -> a -> b
$ do
    let p :: Double
p = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GraphConfig -> Int
graphBorderWidth GraphConfig
cfg)
    Double -> Render ()
C.setLineWidth Double
p
    Double -> Double -> Double -> Double -> Render ()
C.setSourceRGBA Double
frameR Double
frameG Double
frameB Double
frameA
    Double -> Double -> Double -> Double -> Render ()
C.rectangle (Double
fpad Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
p Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2)) (Double
fpad Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
p Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2))
       (Double
fw Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
fpad Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
p) (Double
fh Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
fpad Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
p)
    Render ()
C.stroke


renderGraph :: [Seq Double] -> GraphConfig -> Int -> Int -> Double -> C.Render ()
renderGraph :: [Seq Double] -> GraphConfig -> Int -> Int -> Double -> Render ()
renderGraph [Seq Double]
hists GraphConfig
cfg Int
w Int
h Double
xStep = do
  GraphConfig -> Int -> Int -> Render ()
renderFrameAndBackground GraphConfig
cfg Int
w Int
h

  Double -> Render ()
C.setLineWidth Double
0.1

  let pad :: Double
pad = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ GraphConfig -> Int
graphPadding GraphConfig
cfg
  let framePad :: Double
framePad = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ GraphConfig -> Int
graphBorderWidth GraphConfig
cfg

  -- Make the new origin be inside the frame and then scale the drawing area so
  -- that all operations in terms of width and height are inside the drawn
  -- frame.
  Double -> Double -> Render ()
C.translate (Double
pad Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
framePad) (Double
pad Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
framePad)
  let xS :: Double
xS = (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
pad Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
framePad) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w
      yS :: Double
yS = (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
pad Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
framePad) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h
  Double -> Double -> Render ()
C.scale Double
xS Double
yS

  -- If right-to-left direction is requested, apply an horizontal inversion
  -- transformation with an offset to the right equal to the width of the
  -- widget.
  Bool -> Render () -> Render ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GraphConfig -> GraphDirection
graphDirection GraphConfig
cfg GraphDirection -> GraphDirection -> Bool
forall a. Eq a => a -> a -> Bool
== GraphDirection
RIGHT_TO_LEFT) (Render () -> Render ()) -> Render () -> Render ()
forall a b. (a -> b) -> a -> b
$
      Matrix -> Render ()
C.transform (Matrix -> Render ()) -> Matrix -> Render ()
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double -> Double -> Double -> Double -> Matrix
M.Matrix (-Double
1) Double
0 Double
0 Double
1 (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w) Double
0

  let pctToY :: Double -> Double
pctToY Double
pct = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
pct)
      renderDataSet :: Seq Double -> RGBA -> GraphStyle -> Render ()
renderDataSet Seq Double
hist RGBA
color GraphStyle
style
        | Seq Double -> Int
forall a. Seq a -> Int
S.length Seq Double
hist Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 = () -> Render ()
forall a. a -> Render a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        | Bool
otherwise = do
          let (Double
r, Double
g, Double
b, Double
a) = RGBA
color
              originY :: Double
originY = Double -> Double
pctToY Double
newestSample
              originX :: Double
originX = Double
0
              Double
newestSample :< Seq Double
hist' = Seq Double -> ViewL Double
forall a. Seq a -> ViewL a
viewl Seq Double
hist
          Double -> Double -> Double -> Double -> Render ()
C.setSourceRGBA Double
r Double
g Double
b Double
a
          Double -> Double -> Render ()
C.moveTo Double
originX Double
originY

          (Double -> Render ()) -> Seq Double -> Render ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Double -> Double) -> Double -> Double -> Render ()
outlineData Double -> Double
pctToY Double
xStep) Seq Double
hist'
          case GraphStyle
style of
            GraphStyle
Area -> do
              (Double
endX, Double
_) <- Render (Double, Double)
C.getCurrentPoint
              Double -> Double -> Render ()
C.lineTo Double
endX (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h)
              Double -> Double -> Render ()
C.lineTo Double
0 (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h)
              Render ()
C.fill
            GraphStyle
Line -> do
              Double -> Render ()
C.setLineWidth Double
1.0
              Render ()
C.stroke


  [Render ()] -> Render ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([Render ()] -> Render ()) -> [Render ()] -> Render ()
forall a b. (a -> b) -> a -> b
$ (Seq Double -> RGBA -> GraphStyle -> Render ())
-> [Seq Double] -> [RGBA] -> [GraphStyle] -> [Render ()]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 Seq Double -> RGBA -> GraphStyle -> Render ()
renderDataSet [Seq Double]
hists (GraphConfig -> [RGBA]
graphDataColors GraphConfig
cfg)
            (GraphConfig -> [GraphStyle]
graphDataStyles GraphConfig
cfg)

drawBorder :: MVar GraphState -> Gtk.DrawingArea -> C.Render ()
drawBorder :: MVar GraphState -> DrawingArea -> Render ()
drawBorder MVar GraphState
mv DrawingArea
drawArea = do
  (Int
w, Int
h) <- DrawingArea -> Render (Int, Int)
forall self (m :: * -> *).
(IsWidget self, MonadIO m) =>
self -> m (Int, Int)
widgetGetAllocatedSize DrawingArea
drawArea
  GraphState
s <- IO GraphState -> Render GraphState
forall a. IO a -> Render a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GraphState -> Render GraphState)
-> IO GraphState -> Render GraphState
forall a b. (a -> b) -> a -> b
$ MVar GraphState -> IO GraphState
forall a. MVar a -> IO a
readMVar MVar GraphState
mv
  let cfg :: GraphConfig
cfg = GraphState -> GraphConfig
graphConfig GraphState
s
  GraphConfig -> Int -> Int -> Render ()
renderFrameAndBackground GraphConfig
cfg Int
w Int
h
  IO () -> Render ()
forall a. IO a -> Render a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Render ()) -> IO () -> Render ()
forall a b. (a -> b) -> a -> b
$ MVar GraphState -> (GraphState -> IO GraphState) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar GraphState
mv (\GraphState
s' -> GraphState -> IO GraphState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GraphState
s' { graphIsBootstrapped :: Bool
graphIsBootstrapped = Bool
True })
  () -> Render ()
forall a. a -> Render a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

drawGraph :: MVar GraphState -> Gtk.DrawingArea ->  C.Render ()
drawGraph :: MVar GraphState -> DrawingArea -> Render ()
drawGraph MVar GraphState
mv DrawingArea
drawArea = do
  (Int
w, Int
h) <- DrawingArea -> Render (Int, Int)
forall self (m :: * -> *).
(IsWidget self, MonadIO m) =>
self -> m (Int, Int)
widgetGetAllocatedSize DrawingArea
drawArea
  MVar GraphState -> DrawingArea -> Render ()
drawBorder MVar GraphState
mv DrawingArea
drawArea
  GraphState
s <- IO GraphState -> Render GraphState
forall a. IO a -> Render a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GraphState -> Render GraphState)
-> IO GraphState -> Render GraphState
forall a b. (a -> b) -> a -> b
$ MVar GraphState -> IO GraphState
forall a. MVar a -> IO a
readMVar MVar GraphState
mv
  let hist :: [Seq Double]
hist = GraphState -> [Seq Double]
graphHistory GraphState
s
      cfg :: GraphConfig
cfg = GraphState -> GraphConfig
graphConfig GraphState
s
      histSize :: Int
histSize = GraphConfig -> Int
graphHistorySize GraphConfig
cfg
      -- Subtract 1 here since the first data point doesn't require
      -- any movement in the X direction
      xStep :: Double
xStep = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
histSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

  case [Seq Double]
hist of
    [] -> GraphConfig -> Int -> Int -> Render ()
renderFrameAndBackground GraphConfig
cfg Int
w Int
h
    [Seq Double]
_ -> [Seq Double] -> GraphConfig -> Int -> Int -> Double -> Render ()
renderGraph [Seq Double]
hist GraphConfig
cfg Int
w Int
h Double
xStep

graphNew :: MonadIO m => GraphConfig -> m (Gtk.Widget, GraphHandle)
graphNew :: forall (m :: * -> *).
MonadIO m =>
GraphConfig -> m (Widget, GraphHandle)
graphNew GraphConfig
cfg = IO (Widget, GraphHandle) -> m (Widget, GraphHandle)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Widget, GraphHandle) -> m (Widget, GraphHandle))
-> IO (Widget, GraphHandle) -> m (Widget, GraphHandle)
forall a b. (a -> b) -> a -> b
$ do
  DrawingArea
drawArea <- IO DrawingArea
forall (m :: * -> *). (HasCallStack, MonadIO m) => m DrawingArea
Gtk.drawingAreaNew
  MVar GraphState
mv <- GraphState -> IO (MVar GraphState)
forall a. a -> IO (MVar a)
newMVar GraphState { graphIsBootstrapped :: Bool
graphIsBootstrapped = Bool
False
                           , graphHistory :: [Seq Double]
graphHistory = []
                           , graphCanvas :: DrawingArea
graphCanvas = DrawingArea
drawArea
                           , graphConfig :: GraphConfig
graphConfig = GraphConfig
cfg
                           }

  DrawingArea -> Int32 -> Int32 -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> Int32 -> Int32 -> m ()
Gtk.widgetSetSizeRequest DrawingArea
drawArea (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ GraphConfig -> Int
graphWidth GraphConfig
cfg) (-Int32
1)
  SignalHandlerId
_ <- DrawingArea
-> ((?self::DrawingArea) => WidgetDrawCallback)
-> IO SignalHandlerId
forall a (m :: * -> *).
(IsWidget a, MonadIO m) =>
a -> ((?self::a) => WidgetDrawCallback) -> m SignalHandlerId
Gtk.onWidgetDraw DrawingArea
drawArea (((?self::DrawingArea) => WidgetDrawCallback)
 -> IO SignalHandlerId)
-> ((?self::DrawingArea) => WidgetDrawCallback)
-> IO SignalHandlerId
forall a b. (a -> b) -> a -> b
$ \Context
ctx -> Render () -> Context -> IO ()
forall (m :: * -> *) a. MonadIO m => Render a -> Context -> m a
renderWithContext
       (MVar GraphState -> DrawingArea -> Render ()
drawGraph MVar GraphState
mv DrawingArea
drawArea) Context
ctx IO () -> IO Bool -> IO Bool
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
  Box
box <- Orientation -> Int32 -> IO Box
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Orientation -> Int32 -> m Box
Gtk.boxNew Orientation
Gtk.OrientationHorizontal Int32
1


  DrawingArea -> Bool -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> Bool -> m ()
Gtk.widgetSetVexpand DrawingArea
drawArea Bool
True
  Box -> Bool -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> Bool -> m ()
Gtk.widgetSetVexpand Box
box Bool
True
  Box -> DrawingArea -> Bool -> Bool -> Word32 -> IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsBox a, IsWidget b) =>
a -> b -> Bool -> Bool -> Word32 -> m ()
Gtk.boxPackStart Box
box DrawingArea
drawArea Bool
True Bool
True Word32
0

  Widget
widget <- case GraphConfig -> Maybe Text
graphLabel GraphConfig
cfg of
    Maybe Text
Nothing  -> Box -> IO Widget
forall (m :: * -> *) o. (MonadIO m, IsWidget o) => o -> m Widget
Gtk.toWidget Box
box
    Just Text
labelText -> do
      Overlay
overlay <- IO Overlay
forall (m :: * -> *). (HasCallStack, MonadIO m) => m Overlay
Gtk.overlayNew
      Label
label <- Maybe Text -> IO Label
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe Text -> m Label
Gtk.labelNew Maybe Text
forall a. Maybe a
Nothing
      Label -> Text -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLabel a) =>
a -> Text -> m ()
Gtk.labelSetMarkup Label
label Text
labelText
      Overlay -> Box -> IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsContainer a, IsWidget b) =>
a -> b -> m ()
Gtk.containerAdd Overlay
overlay Box
box
      Overlay -> Label -> IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsOverlay a, IsWidget b) =>
a -> b -> m ()
Gtk.overlayAddOverlay Overlay
overlay Label
label
      Overlay -> IO Widget
forall (m :: * -> *) o. (MonadIO m, IsWidget o) => o -> m Widget
Gtk.toWidget Overlay
overlay

  Widget -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ()
Gtk.widgetShowAll Widget
widget

  (Widget, GraphHandle) -> IO (Widget, GraphHandle)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget
widget, MVar GraphState -> GraphHandle
GH MVar GraphState
mv)