threadscope-0.1: Sidebar.hs

module Sidebar (
    setupSideBar,
    sidebarBookmarks,
    sidebarTraces,
  ) where

import State
import Timeline

import Graphics.UI.Gtk
import Graphics.UI.Gtk.Gdk.EventM

import Data.IORef
import Control.Monad
import Control.Monad.Trans

-- XXX: we should be using a Model here, but not sure how to do that
-- with Glade.
sidebarTraces, sidebarBookmarks :: Int
sidebarTraces    = 0
sidebarBookmarks = 1

setupSideBar :: ViewerState -> IO ()
setupSideBar state@ViewerState{..} = do
  on sidebarCloseButton buttonPressEvent $ tryEvent $ liftIO $ do
     checkMenuItemSetActive sidebarToggle False
     containerRemove hpaned sidebarVBox
     
  onToggle sidebarToggle $ do -- no new-style event for menu toggles?
     b <- checkMenuItemGetActive sidebarToggle
     if b 
        then panedAdd1 hpaned sidebarVBox
        else containerRemove hpaned sidebarVBox

  on sidebarCombo changed $ do
     sidebarChangeView state

  writeIORef sidebarComboState 1
  comboBoxSetActive sidebarCombo 0
  sidebarChangeView state

  traceColumn <- treeViewColumnNew
--  treeViewColumnSetTitle traceColumn "Trace"

  textcell <- cellRendererTextNew
  togglecell <- cellRendererToggleNew

  treeViewColumnPackStart traceColumn textcell True
  treeViewColumnPackEnd   traceColumn togglecell False

  cellLayoutSetAttributes traceColumn textcell tracesStore $
          \(t,bool) -> case t of
                         TraceGroup str -> [cellText := str]
                         TraceHEC   n   -> [cellText := show n]
                         TraceThread n  -> [cellText := show n]
                         TraceActivity  -> [cellText := "Activity Profile"]

  cellLayoutSetAttributes traceColumn togglecell tracesStore $
          \(str,bool) -> [cellToggleActive := bool]

  on togglecell cellToggled $ \str ->  do
    let p = stringToTreePath str
    (str,bool) <- treeStoreGetValue tracesStore p
    treeStoreSetValue tracesStore p (str, not bool)
    timelineParamsChanged state

  treeViewAppendColumn tracesTreeView traceColumn

  return ()

sidebarChangeView :: ViewerState -> IO ()
sidebarChangeView state@ViewerState{..} = do
  r <- readIORef sidebarComboState
  v <- comboBoxGetActive sidebarCombo
  when (v /= r) $ do
   writeIORef sidebarComboState v
   case v of
    _ | v == sidebarTraces -> do
        containerRemove sidebarVBox bookmarkVBox
        boxPackEnd sidebarVBox tracesVBox PackGrow 0
        widgetShowAll tracesVBox

      | v == sidebarBookmarks -> do
        containerRemove sidebarVBox tracesVBox
        boxPackEnd sidebarVBox bookmarkVBox PackGrow 0
        widgetShowAll bookmarkVBox

    _ ->
      return ()