1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
module GUI.SummaryView (
InfoView,
summaryViewNew,
summaryViewSetEvents,
) where
import GHC.RTS.Events
import GUI.Timeline.Render.Constants
import Graphics.UI.Gtk
import Graphics.Rendering.Cairo
import Data.Array
import Data.IORef
-------------------------------------------------------------------------------
data InfoView = InfoView
{ gtkLayout :: !Layout
, stateRef :: !(IORef InfoState)
}
data InfoState
= InfoEmpty
| InfoLoaded
{ infoState :: String
}
-------------------------------------------------------------------------------
infoViewNew :: String -> Builder -> IO InfoView
infoViewNew widgetName builder = do
stateRef <- newIORef undefined
let getWidget cast = builderGetObject builder cast
gtkLayout <- getWidget castToLayout widgetName
writeIORef stateRef InfoEmpty
let infoView = InfoView{..}
-- Drawing
on gtkLayout exposeEvent $ liftIO $ do
drawInfo infoView =<< readIORef stateRef
return True
return infoView
summaryViewNew :: Builder -> IO InfoView
summaryViewNew = infoViewNew "eventsLayoutSummary"
-------------------------------------------------------------------------------
infoViewSetEvents :: (Array Int CapEvent -> InfoState)
-> InfoView -> Maybe (Array Int CapEvent) -> IO ()
infoViewSetEvents f InfoView{gtkLayout, stateRef} mevents = do
let infoState = case mevents of
Nothing -> InfoEmpty
Just events -> f events
writeIORef stateRef infoState
widgetQueueDraw gtkLayout
summaryViewProcessEvents :: Array Int CapEvent -> InfoState
summaryViewProcessEvents _events = InfoLoaded "TODO"
summaryViewSetEvents :: InfoView -> Maybe (Array Int CapEvent) -> IO ()
summaryViewSetEvents = infoViewSetEvents summaryViewProcessEvents
-------------------------------------------------------------------------------
drawInfo :: InfoView -> InfoState -> IO ()
drawInfo _ InfoEmpty = return ()
drawInfo InfoView{gtkLayout} InfoLoaded{..} = do
win <- layoutGetDrawWindow gtkLayout
pangoCtx <- widgetGetPangoContext gtkLayout
layout <- layoutText pangoCtx infoState
(_, Rectangle _ _ width height) <- layoutGetPixelExtents layout
layoutSetSize gtkLayout (width + 30) (height + 30)
renderWithDrawable win $ do
moveTo (fromIntegral ox / 2) (fromIntegral ox / 3)
showLayout layout
|
