From 5f76224c5d06f8dc1115c7d26eebd805929c383e Mon Sep 17 00:00:00 2001 From: Rebecca Li Date: Fri, 23 Feb 2018 13:52:38 -0800 Subject: [PATCH 1/6] Refactored signal selector --- src/PlotHo/PlotTypes.hs | 2 +- src/PlotHo/SignalSelector.hs | 563 +++++++++++++++++++++-------------- 2 files changed, 347 insertions(+), 218 deletions(-) diff --git a/src/PlotHo/PlotTypes.hs b/src/PlotHo/PlotTypes.hs index 0b5205e..4c957ad 100644 --- a/src/PlotHo/PlotTypes.hs +++ b/src/PlotHo/PlotTypes.hs @@ -49,7 +49,7 @@ data ListViewInfo where ListViewInfo :: { lviName :: ![String] , lviTypeOrGetter :: !(Either String (a -> [[(Double,Double)]])) - , lviMarked :: !MarkedState + , lviMarked :: ![MarkedState] , lviPlotValueRef :: IORef a } -> ListViewInfo diff --git a/src/PlotHo/SignalSelector.hs b/src/PlotHo/SignalSelector.hs index c929d80..f80e6fb 100644 --- a/src/PlotHo/SignalSelector.hs +++ b/src/PlotHo/SignalSelector.hs @@ -6,12 +6,14 @@ module PlotHo.SignalSelector ( SignalSelector(..) , newSignalSelectorArea + , newMultiSignalSelectorArea + , gettersAndTitle ) where import qualified Control.Concurrent as CC import Control.Monad ( unless, void, when ) import Data.IORef ( IORef, readIORef ) -import Data.List ( foldl', intercalate ) +import Data.List ( foldl', intercalate, elemIndex ) import qualified Data.Map as M import Data.Maybe ( isNothing, fromJust ) import Data.Tree ( Tree ) @@ -19,6 +21,7 @@ import qualified Data.Tree as Tree import "gtk3" Graphics.UI.Gtk ( AttrOp( (:=) ) ) import qualified "gtk3" Graphics.UI.Gtk as Gtk import System.Glib.Signals ( on ) +import System.Glib.UTFString ( DefaultGlibString ) import PlotHo.PlotTypes @@ -29,246 +32,372 @@ data SignalSelector , ssToPlotValues :: IO (Maybe String, [(String, [[(Double, Double)]])]) } +newMultiSignalSelectorArea :: [Element] -> Int -> IO SignalSelector +newMultiSignalSelectorArea elems numCols = do + graphInfoMVar <- CC.newMVar (Nothing, []) + + -- Be sure to get the # columns right or there will be a runtime error + treeStore <- Gtk.treeStoreNew $ initialForest elems (numCols + 1) + treeview <- Gtk.treeViewNewWithModel treeStore + + Gtk.treeViewSetHeadersVisible treeview True + + (setSignalAttrAndRender, _) <- signalColumn treeStore treeview "signal" + -- add some columns + + attrAndCol <- mapM (\n -> checkMarkColumn treeStore treeview ("Dummy!" ++ show n)) [1,2..numCols] + let (setAttrAndRenders, columns) = unzip $ attrAndCol + -- set the attributes + sequence_ setAttrAndRenders + setSignalAttrAndRender + + --TODO(Rebecca) new update function + let updateGettersAndTitle' = updateGettersAndTitle graphInfoMVar treeStore treeview (head columns) + + return + SignalSelector + { ssTreeView = treeview + , ssRebuildSignalTree = rebuildSignalTree treeStore updateGettersAndTitle' treeview + , ssToPlotValues = toValues graphInfoMVar + } + newSignalSelectorArea :: [Element] -> IO () -> IO SignalSelector newSignalSelectorArea elems redraw = do -- mvar with all the user input graphInfoMVar <- CC.newMVar (Nothing, []) - let initialForest :: [Tree ListViewInfo] - initialForest = map (\(Element e) -> toNode e) elems - where - toNode :: Element' a -> Tree ListViewInfo - toNode element = - Tree.Node - { Tree.rootLabel = - ListViewInfo - { lviName = [chanName (eChannel element)] - , lviMarked = Off - , lviTypeOrGetter = Left "" - , lviPlotValueRef = ePlotValueRef element - } - , Tree.subForest = [] - } - treeStore <- Gtk.treeStoreNew initialForest + treeStore <- Gtk.treeStoreNew $ initialForest elems 2 treeview <- Gtk.treeViewNewWithModel treeStore Gtk.treeViewSetHeadersVisible treeview True -- add some columns - colSignal <- Gtk.treeViewColumnNew + -- the signal column + (setSignalAttrAndRender, _) <- signalColumn treeStore treeview "signal" + + -- the selection column colVisible <- Gtk.treeViewColumnNew - Gtk.treeViewColumnSetTitle colSignal "signal" Gtk.treeViewColumnSetTitle colVisible "visible?" - - rendererSignal <- Gtk.cellRendererTextNew rendererVisible <- Gtk.cellRendererToggleNew - - Gtk.treeViewColumnPackStart colSignal rendererSignal True Gtk.treeViewColumnPackStart colVisible rendererVisible True + let updateGettersAndTitle' = updateGettersAndTitle graphInfoMVar treeStore treeview colVisible + appendColumn treeview colVisible - let showName :: Either String b -> [String] -> String - -- show a getter name - showName (Right _) (name:_) = name - showName (Right _) [] = error "showName on field got an empty list" - -- show a parent without type info - showName (Left "") (name:_) = name - -- show a parent with type info - showName (Left typeName) (name:_) = name ++ " (" ++ typeName ++ ")" - showName (Left _) [] = error "showName on parent got an empty list" - - Gtk.cellLayoutSetAttributes colSignal rendererSignal treeStore $ - \(ListViewInfo {lviName = name, lviTypeOrGetter = typeOrGetter}) -> - [ Gtk.cellText := showName typeOrGetter (reverse name) - ] - Gtk.cellLayoutSetAttributes colVisible rendererVisible treeStore $ \lvi -> case lviMarked lvi of - On -> [ Gtk.cellToggleInconsistent := False - , Gtk.cellToggleActive := True - ] - Off -> [ Gtk.cellToggleInconsistent := False - , Gtk.cellToggleActive := False - ] - Inconsistent -> [ Gtk.cellToggleActive := False - , Gtk.cellToggleInconsistent := True - ] - - void $ Gtk.treeViewAppendColumn treeview colSignal - void $ Gtk.treeViewAppendColumn treeview colVisible - - let -- traverse the whole graph and update the list of getters and the title - updateGettersAndTitle = do - -- first get all trees - let getTrees k = do - tree' <- Gtk.treeStoreLookup treeStore [k] - case tree' of Nothing -> return [] - Just tree -> fmap (tree:) (getTrees (k+1)) - theTrees <- getTrees 0 - let newGetters0 :: [([String], IO [[(Double, Double)]])] - newGetters0 = - [ (name, getter <$> readIORef plotValueRef) - | ListViewInfo - { lviName = name - , lviTypeOrGetter = Right getter - , lviMarked = On - , lviPlotValueRef = plotValueRef - } <- concatMap Tree.flatten theTrees - ] - - let newGetters :: [(String, IO [[(Double, Double)]])] - newTitle :: Maybe String - (newGetters, newTitle) = gettersAndTitle newGetters0 - - void $ newTitle `seq` newGetters `seq` - CC.swapMVar graphInfoMVar (newTitle, newGetters) - - i2p i = Gtk.treeModelGetPath treeStore i - p2i p = do - mi <- Gtk.treeModelGetIter treeStore p - case mi of Nothing -> error "no iter at that path" - Just i -> return i + -- Now, we can set the attributes and render since the order of the columns is set. + colVisibleNumber <- getColumnNumber treeview colVisible + Gtk.cellLayoutSetAttributes colVisible rendererVisible treeStore $ \lvi -> (markedAttribute colVisibleNumber lvi) + + setSignalAttrAndRender - -- update which y axes are visible - _ <- on rendererVisible Gtk.cellToggled $ \pathStr -> do - let treePath = Gtk.stringToTreePath pathStr - - getChildrenPaths path' = do - iter' <- p2i path' - let getChildPath k = do - mc <- Gtk.treeModelIterNthChild treeStore (Just iter') k - case mc of - Nothing -> error "no child" - Just c -> i2p c - n <- Gtk.treeModelIterNChildren treeStore (Just iter') - mapM getChildPath (take n [0..]) - - changeSelfAndChildren change path' = do - childrenPaths <- getChildrenPaths path' - ret <- Gtk.treeStoreChange treeStore path' change - when (not ret) $ error "treeStoreChange fail" - mapM_ (changeSelfAndChildren change) childrenPaths - - fixInconsistent path' = do - mparentIter <- p2i path' >>= Gtk.treeModelIterParent treeStore - case mparentIter of - Nothing -> return () - Just parentIter -> do - parentPath <- i2p parentIter - siblingPaths <- getChildrenPaths parentPath - siblings <- mapM (Gtk.treeStoreGetValue treeStore) siblingPaths - let markedSiblings :: [MarkedState] - markedSiblings = map lviMarked siblings - - changeParent - | all (== On) markedSiblings = - Gtk.treeStoreChange treeStore parentPath (\lvi -> lvi {lviMarked = On}) - | all (== Off) markedSiblings = - Gtk.treeStoreChange treeStore parentPath (\lvi -> lvi {lviMarked = Off}) - | otherwise = - Gtk.treeStoreChange treeStore parentPath (\lvi -> lvi {lviMarked = Inconsistent}) - ret <- changeParent - when (not ret) $ error "fixInconsistent couldn't change parent" - fixInconsistent parentPath - return () - - -- toggle the check mark - val <- Gtk.treeStoreGetValue treeStore treePath - case val of - (ListViewInfo {lviTypeOrGetter = Left _, lviMarked = Off}) -> - changeSelfAndChildren (\lvi -> lvi {lviMarked = On}) treePath - (ListViewInfo {lviTypeOrGetter = Left _, lviMarked = On}) -> - changeSelfAndChildren (\lvi -> lvi {lviMarked = Off}) treePath - (ListViewInfo {lviTypeOrGetter = Left _, lviMarked =Inconsistent}) -> - changeSelfAndChildren (\lvi -> lvi {lviMarked = On}) treePath - lvi@(ListViewInfo {lviTypeOrGetter = Right _, lviMarked = On}) -> - Gtk.treeStoreSetValue treeStore treePath $ lvi {lviMarked = Off} - lvi@(ListViewInfo {lviTypeOrGetter = Right _, lviMarked = Off}) -> - Gtk.treeStoreSetValue treeStore treePath $ lvi {lviMarked = On} - (ListViewInfo {lviTypeOrGetter = Right _, lviMarked = Inconsistent}) -> - error "cell getter can't be inconsistent" - - fixInconsistent treePath - updateGettersAndTitle - redraw - - let -- rebuild the signal tree - rebuildSignalTree :: forall a . Element' a -> SignalTree a -> IO () - rebuildSignalTree element meta = do - let channel = eChannel element - elementIndex = eIndex element - putStrLn $ "rebuilding signal tree for " ++ show (chanName channel) - - mtreeIter <- Gtk.treeModelIterNthChild treeStore Nothing elementIndex - - treePath <- case mtreeIter of - Nothing -> error $ "rebuildSignalTree: error looking up channel index " ++ show elementIndex - Just treeIter -> i2p treeIter - - unless (treePath == [elementIndex]) $ error "rebuildSignalTree: I don't understand tree paths" - - moldTree <- Gtk.treeStoreLookup treeStore treePath - oldTree <- case moldTree of - Nothing -> error "rebuildSignalTree: the old tree wasn't found" - Just r -> return r - let _ = oldTree :: Tree ListViewInfo - - plotValueRef :: IORef a - plotValueRef = ePlotValueRef element - - merge :: [Tree ListViewInfo] - -> [Tree ([String], Either String (a -> [[(Double, Double)]]))] - -> [Tree ListViewInfo] - merge old new = map convert new - where - oldMap :: M.Map ([String], Maybe String) (ListViewInfo, [Tree ListViewInfo]) - oldMap = M.fromList $ map f old - where - f (Tree.Node lvi lvis) = ((lviName lvi, maybeType), (lvi, lvis)) - where - maybeType = case lvi of - ListViewInfo {lviTypeOrGetter = Left typ} -> Just typ - _ -> Nothing - - convert :: Tree ([String], Either String (a -> [[(Double, Double)]])) - -> Tree ListViewInfo - convert (Tree.Node (name, tog) others) = case M.lookup (name, maybeType) oldMap of - Nothing -> Tree.Node (ListViewInfo name tog Off plotValueRef) (merge [] others) - Just (lvi, oldOthers) -> - Tree.Node (ListViewInfo name tog (lviMarked lvi) plotValueRef) (merge oldOthers others) - where - maybeType = case tog of - Left r -> Just r - Right _ -> Nothing - - newTree :: Tree ListViewInfo - newTree = case merge [oldTree] [meta] of - [r] -> r - [] -> error "rebuildSignalTree: merged old tree with new tree and got []" - _ -> error "rebuildSignalTree: merged old tree with new tree and got a forest" - - removed <- Gtk.treeStoreRemove treeStore treePath - unless removed $ error "rebuildSignalTree: error removing old tree" - Gtk.treeStoreInsertTree treeStore [] elementIndex newTree - updateGettersAndTitle - - toValues = do - (mtitle, getters) <- CC.readMVar graphInfoMVar - let _ = getters :: [(String, IO [[(Double, Double)]])] - - execGetter :: (String, IO [[(Double, Double)]]) -> IO (String, [[(Double, Double)]]) - execGetter (name, get) = do - got <- get - return (name, got) - gotten <- mapM execGetter getters - return (mtitle, gotten) + _ <- on rendererVisible Gtk.cellToggled $ \pathStr -> renderPlotSignal colVisibleNumber treeStore pathStr redraw updateGettersAndTitle' return SignalSelector { ssTreeView = treeview - , ssRebuildSignalTree = rebuildSignalTree - , ssToPlotValues = toValues + , ssRebuildSignalTree = rebuildSignalTree treeStore updateGettersAndTitle' treeview + , ssToPlotValues = toValues graphInfoMVar } +signalColumn :: forall a . Gtk.TreeViewClass a => Gtk.TreeStore ListViewInfo -> a -> String + -> IO (IO (), Gtk.TreeViewColumn) +signalColumn treeStore treeview columnName = do + colSignal <- Gtk.treeViewColumnNew + Gtk.treeViewColumnSetTitle colSignal columnName + rendererSignal <- Gtk.cellRendererTextNew + Gtk.treeViewColumnPackStart colSignal rendererSignal True + appendColumn treeview colSignal + let setAttributeAndRender :: IO () + setAttributeAndRender = + Gtk.cellLayoutSetAttributes colSignal rendererSignal treeStore $ + \ListViewInfo {lviName = name, lviTypeOrGetter = typeOrGetter} -> + [ Gtk.cellText := showName typeOrGetter (reverse name) + ] + return (setAttributeAndRender, colSignal) + + +checkMarkColumn :: forall a . Gtk.TreeViewClass a => Gtk.TreeStore ListViewInfo -> a -> String + -> IO (IO (), Gtk.TreeViewColumn) +checkMarkColumn treeStore treeview columnName = do + colCheckMark <- Gtk.treeViewColumnNew + Gtk.treeViewColumnSetTitle colCheckMark columnName + rendererCheckMark <- Gtk.cellRendererToggleNew + Gtk.treeViewColumnPackStart colCheckMark rendererCheckMark True + appendColumn treeview colCheckMark + let setAttributeAndRender :: IO () + setAttributeAndRender = do + colNum <- getColumnNumber treeview colCheckMark + Gtk.cellLayoutSetAttributes colCheckMark rendererCheckMark treeStore $ \lvi -> (markedAttribute colNum lvi) + _ <- on rendererCheckMark Gtk.cellToggled $ \pathStr -> toggleCheckMark treeStore colNum pathStr + return () + -- update which y axes are CheckMark + return (setAttributeAndRender, colCheckMark) + +appendColumn :: forall a . Gtk.TreeViewClass a => a -> Gtk.TreeViewColumn -> IO () +appendColumn treeview col = do + void $ Gtk.treeViewAppendColumn treeview col + --TODO(rebecca): append proper number of columns to lvi + + +initialForest :: [Element] -> Int -> [Tree ListViewInfo] +initialForest elems numCols = map (\(Element e) -> toNode e) elems + where + toNode :: Element' a -> Tree ListViewInfo + toNode element = + Tree.Node + { Tree.rootLabel = + ListViewInfo + { lviName = [chanName (eChannel element)] + , lviMarked = take numCols $ repeat Off + , lviTypeOrGetter = Left "" + , lviPlotValueRef = ePlotValueRef element + } + , Tree.subForest = [] + } + +showName :: Either String b -> [String] -> String +-- show a getter name +showName (Right _) (name:_) = name +showName (Right _) [] = error "showName on field got an empty list" +-- show a parent without type info +showName (Left "") (name:_) = name +-- show a parent with type info +showName (Left typeName) (name:_) = name ++ " (" ++ typeName ++ ")" +showName (Left _) [] = error "showName on parent got an empty list" + +getColumnNumber :: forall a . Gtk.TreeViewClass a => a -> Gtk.TreeViewColumn -> IO Int +getColumnNumber treeview col = do + cols <- Gtk.treeViewGetColumns treeview + let mColNum = elemIndex col cols + case mColNum of + Just n -> return n + Nothing -> error "can't find column number" + +setMark :: Int -> [MarkedState] -> MarkedState -> [MarkedState] +setMark colNum oldStates mark = take colNum oldStates ++ [mark] ++ drop (colNum + 1) oldStates + +getMark :: Int -> [MarkedState] -> MarkedState +getMark colNum oldStates = oldStates !! colNum + +markedAttribute :: Int -> ListViewInfo -> [AttrOp Gtk.CellRendererToggle] +markedAttribute colNum lvi = case ((lviMarked lvi) !! colNum) of + On -> [ Gtk.cellToggleInconsistent := False + , Gtk.cellToggleActive := True + ] + Off -> [ Gtk.cellToggleInconsistent := False + , Gtk.cellToggleActive := False + ] + Inconsistent -> [ Gtk.cellToggleActive := False + , Gtk.cellToggleInconsistent := True + ] + + +toggleCheckMark :: Gtk.TreeStore ListViewInfo -> Int -> DefaultGlibString -> IO () +toggleCheckMark treeStore colNum pathStr = do + let treePath = Gtk.stringToTreePath pathStr + + (_, changeSelfAndChildren) = getChildrenFuns treeStore + + val <- Gtk.treeStoreGetValue treeStore treePath + let mark = getMark colNum (lviMarked val) + changeMark = setMark colNum (lviMarked val) + case (val, mark) of + (ListViewInfo {lviTypeOrGetter = Left _ }, Off) -> + changeSelfAndChildren (\lvi -> lvi {lviMarked = changeMark On}) treePath + (ListViewInfo {lviTypeOrGetter = Left _ } ,On) -> + changeSelfAndChildren (\lvi -> lvi {lviMarked = changeMark Off}) treePath + (ListViewInfo {lviTypeOrGetter = Left _ }, Inconsistent) -> + changeSelfAndChildren (\lvi -> lvi {lviMarked = changeMark On}) treePath + (lvi@(ListViewInfo {lviTypeOrGetter = Right _}), On) -> + Gtk.treeStoreSetValue treeStore treePath $ lvi {lviMarked = changeMark Off} + (lvi@(ListViewInfo {lviTypeOrGetter = Right _}), Off) -> + Gtk.treeStoreSetValue treeStore treePath $ lvi {lviMarked = changeMark On} + (ListViewInfo {lviTypeOrGetter = Right _}, Inconsistent) -> + error "cell getter can't be inconsistent" + +renderPlotSignal :: Int -> Gtk.TreeStore ListViewInfo -> DefaultGlibString -> IO () -> IO () -> IO () +renderPlotSignal colNum treeStore pathStr redraw updateGettersAndTitle' = do + let i2p i = Gtk.treeModelGetPath treeStore i + p2i p = do + mi <- Gtk.treeModelGetIter treeStore p + case mi of Nothing -> error "no iter at that path" + Just i -> return i + + treePath = Gtk.stringToTreePath pathStr + (getChildrenPaths, _) = getChildrenFuns treeStore + + fixInconsistent path' = do + mparentIter <- p2i path' >>= Gtk.treeModelIterParent treeStore + case mparentIter of + Nothing -> return () + Just parentIter -> do + parentPath <- i2p parentIter + siblingPaths <- getChildrenPaths parentPath + siblings <- mapM (Gtk.treeStoreGetValue treeStore) siblingPaths + parentLvi <- Gtk.treeStoreGetValue treeStore parentPath + let changeParentMark = setMark colNum (lviMarked parentLvi) + markedSiblings :: [MarkedState] + markedSiblings = map ((getMark colNum) . lviMarked) siblings + + changeParent + | all (== On) markedSiblings = + Gtk.treeStoreChange treeStore parentPath (\lvi -> lvi {lviMarked = changeParentMark On}) + | all (== Off) markedSiblings = + Gtk.treeStoreChange treeStore parentPath (\lvi -> lvi {lviMarked = changeParentMark Off}) + | otherwise = + Gtk.treeStoreChange treeStore parentPath (\lvi -> lvi {lviMarked = changeParentMark Inconsistent}) + ret <- changeParent + when (not ret) $ error "fixInconsistent couldn't change parent" + fixInconsistent parentPath + return () + -- toggle the check mark + toggleCheckMark treeStore colNum pathStr + fixInconsistent treePath + updateGettersAndTitle' + redraw + +getChildrenFuns :: Gtk.TreeStore ListViewInfo -> (Gtk.TreePath + -> IO [Gtk.TreePath], (ListViewInfo -> ListViewInfo) -> Gtk.TreePath -> IO ()) +getChildrenFuns treeStore = (getChildrenPaths, changeSelfAndChildren) + where + i2p i = Gtk.treeModelGetPath treeStore i + p2i p = do + mi <- Gtk.treeModelGetIter treeStore p + case mi of Nothing -> error "no iter at that path" + Just i -> return i + + getChildrenPaths path' = do + iter' <- p2i path' + let getChildPath k = do + mc <- Gtk.treeModelIterNthChild treeStore (Just iter') k + case mc of + Nothing -> error "no child" + Just c -> i2p c + n <- Gtk.treeModelIterNChildren treeStore (Just iter') + mapM getChildPath (take n [0..]) + + changeSelfAndChildren change path' = do + childrenPaths <- getChildrenPaths path' + ret <- Gtk.treeStoreChange treeStore path' change + when (not ret) $ error "treeStoreChange fail" + mapM_ (changeSelfAndChildren change) childrenPaths + +-- traverse the whole graph and update the list of getters and the title +updateGettersAndTitle :: forall a . Gtk.TreeViewClass a + => CC.MVar (Maybe String, [(String, IO [[(Double, Double)]])]) + -> Gtk.TreeStore ListViewInfo -> a -> Gtk.TreeViewColumn -> IO () +updateGettersAndTitle graphInfoMVar treeStore treeview colVisible = do + -- first get all trees + let getTrees k = do + tree' <- Gtk.treeStoreLookup treeStore [k] + case tree' of Nothing -> return [] + Just tree -> fmap (tree:) (getTrees (k+1)) + theTrees <- getTrees 0 + colNum <- getColumnNumber treeview colVisible + let newGetters0 :: [([String], IO [[(Double, Double)]])] + newGetters0 = zip names (gots <$> goodLvis) + where + goodLvis = [x | x <- (concatMap Tree.flatten theTrees),isGoodLvi x] + isGoodLvi lvi = (getMark colNum (lviMarked lvi)) == On && rights lvi + where + rights ListViewInfo { lviTypeOrGetter = t } = case t of + Right _ -> True + Left _ -> False + names = lviName <$> goodLvis + gots ListViewInfo{ lviTypeOrGetter = Right getter, lviPlotValueRef = plotValRef} = getter <$> readIORef plotValRef + gots ListViewInfo{ lviTypeOrGetter = Left _, lviPlotValueRef = _} = error "error parsing getters" + {-where + getter ListViewInfo { lviTypeOrGetter = t } = case t of + Right g -> g + Left _ -> error "update getters and title left not filtered" + plotValRef ListViewInfo { lviPlotValueRef = p } = p-} + + let newGetters :: [(String, IO [[(Double, Double)]])] + newTitle :: Maybe String + (newGetters, newTitle) = gettersAndTitle newGetters0 + + void $ newTitle `seq` newGetters `seq` + CC.swapMVar graphInfoMVar (newTitle, newGetters) + +rebuildSignalTree :: forall a t . Gtk.TreeViewClass t + => Gtk.TreeStore ListViewInfo -> IO () -> t + -> Element' a -> SignalTree a + -> IO () +rebuildSignalTree treeStore updateGettersAndTitle' treeview element meta = do + let channel = eChannel element + elementIndex = eIndex element + putStrLn $ "rebuilding signal tree for " ++ show (chanName channel) + + mtreeIter <- Gtk.treeModelIterNthChild treeStore Nothing elementIndex + + treePath <- case mtreeIter of + Nothing -> error $ "rebuildSignalTree: error looking up channel index " ++ show elementIndex + Just treeIter -> i2p treeIter + where + i2p i = Gtk.treeModelGetPath treeStore i + unless (treePath == [elementIndex]) $ error "rebuildSignalTree: I don't understand tree paths" + + moldTree <- Gtk.treeStoreLookup treeStore treePath + oldTree <- case moldTree of + Nothing -> error "rebuildSignalTree: the old tree wasn't found" + Just r -> return r + + columns <- Gtk.treeViewGetColumns treeview + let _ = oldTree :: Tree ListViewInfo + + plotValueRef :: IORef a + plotValueRef = ePlotValueRef element + + merge :: [Tree ListViewInfo] + -> [Tree ([String], Either String (a -> [[(Double, Double)]]))] + -> [Tree ListViewInfo] + merge old new = map convert new + where + oldMap :: M.Map ([String], Maybe String) (ListViewInfo, [Tree ListViewInfo]) + oldMap = M.fromList $ map f old + where + f (Tree.Node lvi lvis) = ((lviName lvi, maybeType), (lvi, lvis)) + where + maybeType = case lvi of + ListViewInfo {lviTypeOrGetter = Left typ} -> Just typ + _ -> Nothing + + convert :: Tree ([String], Either String (a -> [[(Double, Double)]])) + -> Tree ListViewInfo + convert (Tree.Node (name, tog) others) = case M.lookup (name, maybeType) oldMap of + Nothing -> + Tree.Node (ListViewInfo name tog (take (length columns) (repeat Off)) plotValueRef) (merge [] others) + Just (lvi, oldOthers) -> + Tree.Node (ListViewInfo name tog (lviMarked lvi) plotValueRef) (merge oldOthers others) + where + maybeType = case tog of + Left r -> Just r + Right _ -> Nothing + + newTree :: Tree ListViewInfo + newTree = case merge [oldTree] [meta] of + [r] -> r + [] -> error "rebuildSignalTree: merged old tree with new tree and got []" + _ -> error "rebuildSignalTree: merged old tree with new tree and got a forest" + + removed <- Gtk.treeStoreRemove treeStore treePath + unless removed $ error "rebuildSignalTree: error removing old tree" + Gtk.treeStoreInsertTree treeStore [] elementIndex newTree + updateGettersAndTitle' + +toValues :: CC.MVar (Maybe String, [(String, IO [[(Double, Double)]])]) + -> IO (Maybe String, [(String, [[(Double, Double)]])]) +toValues graphInfoMVar = do + (mtitle, getters) <- CC.readMVar graphInfoMVar + let _ = getters :: [(String, IO [[(Double, Double)]])] + + execGetter :: (String, IO [[(Double, Double)]]) -> IO (String, [[(Double, Double)]]) + execGetter (name, get) = do + got <- get + return (name, got) + gotten <- mapM execGetter getters + return (mtitle, gotten) -- The greatest common prefix will be the title. -- Everything after that is the field name. From 306178e4eb4b1f94c688693ec803d19d8a346698 Mon Sep 17 00:00:00 2001 From: Rebecca Li Date: Fri, 23 Feb 2018 14:59:23 -0800 Subject: [PATCH 2/6] added refresh button to multi selector --- src/PlotHo/GraphWidget.hs | 1 + src/PlotHo/Plotter.hs | 69 ++++++++++++++++++++++++++++++++++++--- 2 files changed, 66 insertions(+), 4 deletions(-) diff --git a/src/PlotHo/GraphWidget.hs b/src/PlotHo/GraphWidget.hs index 68f2ab8..88aa782 100644 --- a/src/PlotHo/GraphWidget.hs +++ b/src/PlotHo/GraphWidget.hs @@ -4,6 +4,7 @@ module PlotHo.GraphWidget ( newGraph + , toElement' ) where import Control.Concurrent ( MVar ) diff --git a/src/PlotHo/Plotter.hs b/src/PlotHo/Plotter.hs index 141d0bc..831ff36 100644 --- a/src/PlotHo/Plotter.hs +++ b/src/PlotHo/Plotter.hs @@ -8,7 +8,7 @@ module PlotHo.Plotter import qualified GHC.Stats -import Control.Monad ( unless, void ) +import Control.Monad ( unless, void, zipWithM ) import Control.Monad.IO.Class ( MonadIO(..) ) import qualified Control.Concurrent as CC import Data.Default.Class ( def ) @@ -22,8 +22,9 @@ import System.Exit ( exitFailure ) import System.Glib.Signals ( on ) import Prelude -import PlotHo.GraphWidget ( newGraph ) -import PlotHo.PlotTypes ( Channel(..), Channel'(..), PlotterOptions(..) ) +import PlotHo.GraphWidget ( newGraph, toElement' ) +import PlotHo.PlotTypes ( Channel(..), Channel'(..), Element(..), Element'(..), PlotterOptions(..) ) +import PlotHo.SignalSelector ( SignalSelector(..), newMultiSignalSelectorArea ) -- | fire up the the GUI runPlotter :: Maybe PlotterOptions -> [Channel] -> IO () @@ -81,6 +82,34 @@ runPlotter mplotterOptions channels = do -- add this window to the list to be killed on exit CC.modifyMVar_ graphWindowsToBeKilled (return . (graphWin:)) + buttonSpawnPrefilledGraphs <- Gtk.buttonNewWithLabel "gen prefilled graphs" + void $ on buttonSpawnPrefilledGraphs Gtk.buttonActivated $ do + putStrLn "dummy button" --TODO(Rebecca) + -- graphWin <- newGraph plotterOptions channels + -- add this window to the list to be killed on exit + -- CC.modifyMVar_ graphWindowsToBeKilled (return . (graphWin:)) + + -- Multi Signal Selector + elements <- zipWithM (\k (Channel c) -> Element <$> toElement' k c) [0..] channels + multiSignalSelector <- newMultiSignalSelectorArea elements 3 + + -- refresh signal selector + buttonRefresh <- Gtk.buttonNewWithLabel "refresh" + void $ on buttonRefresh Gtk.buttonActivated (rebuildSignal elements multiSignalSelector) + + treeviewScroll <- Gtk.scrolledWindowNew Nothing Nothing + Gtk.set treeviewScroll [Gtk.widgetVExpand := True] -- make sure it expands vertically + Gtk.containerAdd treeviewScroll (ssTreeView multiSignalSelector) + Gtk.set treeviewScroll + [ Gtk.scrolledWindowHscrollbarPolicy := Gtk.PolicyNever + , Gtk.scrolledWindowVscrollbarPolicy := Gtk.PolicyAutomatic + ] + treeviewExpander <- Gtk.expanderNew "sig" + Gtk.set treeviewExpander + [ Gtk.containerChild := treeviewScroll + , Gtk.expanderExpanded := True + ] + -- clear history / max history widget for each channel chanWidgets <- mapM (\(Channel c) -> newChannelWidget c) channels @@ -105,6 +134,12 @@ runPlotter mplotterOptions channels = do , Gtk.boxChildPacking statsLabel := Gtk.PackNatural , Gtk.containerChild := buttonSpawnGraph , Gtk.boxChildPacking buttonSpawnGraph := Gtk.PackNatural + , Gtk.containerChild := buttonSpawnPrefilledGraphs + , Gtk.boxChildPacking buttonSpawnPrefilledGraphs := Gtk.PackNatural + , Gtk.containerChild := buttonRefresh + , Gtk.boxChildPacking buttonRefresh := Gtk.PackNatural + , Gtk.containerChild := treeviewExpander + , Gtk.boxChildPacking treeviewExpander := Gtk.PackGrow , Gtk.containerChild := scroll ] @@ -115,7 +150,33 @@ runPlotter mplotterOptions channels = do Gtk.widgetShowAll win Gtk.mainGUI - +rebuildSignal :: [Element] -> SignalSelector -> IO () +rebuildSignal elements signalSelector = do + let stageDataFromElement :: forall a . Element' a -> IO () + stageDataFromElement element = do + let msgStore = eMsgStore element + -- get the latest data, just block if they're not available + mdatalog <- CC.takeMVar msgStore + case mdatalog of + -- no data yet, do nothing + Nothing -> CC.putMVar msgStore mdatalog + Just (datalog, msignalTree) -> do + case msignalTree of + -- No new signal tree, no action necessary + Nothing -> return () + -- If there is a new signal tree, we have to merge it with the old one. + Just newSignalTree -> case signalSelector of + SignalSelector {ssRebuildSignalTree = rebuildSignalTree} -> + rebuildSignalTree element newSignalTree + + -- write the data to the IORef so that the getters get the right stuff + IORef.writeIORef (ePlotValueRef element) datalog + + -- Put the data back. Put Nothing to signify that the signal tree is up to date. + CC.putMVar msgStore (Just (datalog, Nothing)) + + -- stage the values + mapM_ (\(Element e) -> stageDataFromElement e) elements -- the list of channels From 81993b7a7cae53e87bfffbc90f9b6555e0930c75 Mon Sep 17 00:00:00 2001 From: Rebecca Li Date: Fri, 23 Feb 2018 15:14:10 -0800 Subject: [PATCH 3/6] fixed bug in checkboxing children --- src/PlotHo/SignalSelector.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/PlotHo/SignalSelector.hs b/src/PlotHo/SignalSelector.hs index f80e6fb..ba7c303 100644 --- a/src/PlotHo/SignalSelector.hs +++ b/src/PlotHo/SignalSelector.hs @@ -200,18 +200,18 @@ toggleCheckMark treeStore colNum pathStr = do val <- Gtk.treeStoreGetValue treeStore treePath let mark = getMark colNum (lviMarked val) - changeMark = setMark colNum (lviMarked val) + changeMark lvi newMark = lvi { lviMarked = setMark colNum (lviMarked lvi) newMark } case (val, mark) of (ListViewInfo {lviTypeOrGetter = Left _ }, Off) -> - changeSelfAndChildren (\lvi -> lvi {lviMarked = changeMark On}) treePath + changeSelfAndChildren (\lvi -> changeMark lvi On) treePath (ListViewInfo {lviTypeOrGetter = Left _ } ,On) -> - changeSelfAndChildren (\lvi -> lvi {lviMarked = changeMark Off}) treePath + changeSelfAndChildren (\lvi -> changeMark lvi Off) treePath (ListViewInfo {lviTypeOrGetter = Left _ }, Inconsistent) -> - changeSelfAndChildren (\lvi -> lvi {lviMarked = changeMark On}) treePath + changeSelfAndChildren (\lvi -> changeMark lvi On) treePath (lvi@(ListViewInfo {lviTypeOrGetter = Right _}), On) -> - Gtk.treeStoreSetValue treeStore treePath $ lvi {lviMarked = changeMark Off} + Gtk.treeStoreSetValue treeStore treePath $ changeMark lvi Off (lvi@(ListViewInfo {lviTypeOrGetter = Right _}), Off) -> - Gtk.treeStoreSetValue treeStore treePath $ lvi {lviMarked = changeMark On} + Gtk.treeStoreSetValue treeStore treePath $ changeMark lvi On (ListViewInfo {lviTypeOrGetter = Right _}, Inconsistent) -> error "cell getter can't be inconsistent" From 388be381871f2e8cdea452dc5d1768db89e04ccc Mon Sep 17 00:00:00 2001 From: Rebecca Li Date: Fri, 23 Feb 2018 16:06:46 -0800 Subject: [PATCH 4/6] Added support for many-plot rebuilds and toPlotValues --- src/PlotHo/GraphWidget.hs | 6 ++--- src/PlotHo/Plotter.hs | 14 ++++++------ src/PlotHo/SignalSelector.hs | 43 ++++++++++++++++++++++++------------ 3 files changed, 39 insertions(+), 24 deletions(-) diff --git a/src/PlotHo/GraphWidget.hs b/src/PlotHo/GraphWidget.hs index 88aa782..b92a5e4 100644 --- a/src/PlotHo/GraphWidget.hs +++ b/src/PlotHo/GraphWidget.hs @@ -26,7 +26,7 @@ import Graphics.Rendering.Chart ( RectSize ) import PlotHo.ChartRender ( toChartRender ) import PlotHo.OptionsWidget ( OptionsWidget(..), makeOptionsWidget ) import PlotHo.PlotTypes -import PlotHo.SignalSelector ( SignalSelector(..), newSignalSelectorArea ) +import PlotHo.SignalSelector ( SignalSelector(..), Selector(..), newSignalSelectorArea ) toElement' :: Int -> Channel' a -> IO (Element' a) @@ -144,7 +144,7 @@ newGraph options channels = do Nothing -> return () -- If there is a new signal tree, we have to merge it with the old one. Just newSignalTree -> case signalSelector of - SignalSelector {ssRebuildSignalTree = rebuildSignalTree} -> + SignalSelector {ssSelectors = Selector {sRebuildSignalTree = rebuildSignalTree}} -> rebuildSignalTree element newSignalTree -- write the data to the IORef so that the getters get the right stuff @@ -159,7 +159,7 @@ newGraph options channels = do -- get the latest plot points -- Now we have rebuild the signal tree if necessary, and staged the latest plot values -- To the geter IORefs. It is safe to get the plot points. - (mtitle, namedPlotPoints) <- ssToPlotValues signalSelector + (mtitle, namedPlotPoints) <- sToPlotValues (ssSelectors signalSelector) debug "handleDraw: got title and plot points" let -- update the min/max plot ranges diff --git a/src/PlotHo/Plotter.hs b/src/PlotHo/Plotter.hs index 831ff36..54e3e56 100644 --- a/src/PlotHo/Plotter.hs +++ b/src/PlotHo/Plotter.hs @@ -24,7 +24,7 @@ import Prelude import PlotHo.GraphWidget ( newGraph, toElement' ) import PlotHo.PlotTypes ( Channel(..), Channel'(..), Element(..), Element'(..), PlotterOptions(..) ) -import PlotHo.SignalSelector ( SignalSelector(..), newMultiSignalSelectorArea ) +import PlotHo.SignalSelector ( SignalSelector(..), Selector(..), newMultiSignalSelectorArea ) -- | fire up the the GUI runPlotter :: Maybe PlotterOptions -> [Channel] -> IO () @@ -95,7 +95,7 @@ runPlotter mplotterOptions channels = do -- refresh signal selector buttonRefresh <- Gtk.buttonNewWithLabel "refresh" - void $ on buttonRefresh Gtk.buttonActivated (rebuildSignal elements multiSignalSelector) + void $ on buttonRefresh Gtk.buttonActivated (rebuildSignals elements multiSignalSelector) treeviewScroll <- Gtk.scrolledWindowNew Nothing Nothing Gtk.set treeviewScroll [Gtk.widgetVExpand := True] -- make sure it expands vertically @@ -150,8 +150,8 @@ runPlotter mplotterOptions channels = do Gtk.widgetShowAll win Gtk.mainGUI -rebuildSignal :: [Element] -> SignalSelector -> IO () -rebuildSignal elements signalSelector = do +rebuildSignals :: [Element] -> SignalSelector [Selector] -> IO () +rebuildSignals elements signalSelector = do let stageDataFromElement :: forall a . Element' a -> IO () stageDataFromElement element = do let msgStore = eMsgStore element @@ -165,9 +165,9 @@ rebuildSignal elements signalSelector = do -- No new signal tree, no action necessary Nothing -> return () -- If there is a new signal tree, we have to merge it with the old one. - Just newSignalTree -> case signalSelector of - SignalSelector {ssRebuildSignalTree = rebuildSignalTree} -> - rebuildSignalTree element newSignalTree + Just newSignalTree -> do + let rebuilds = sRebuildSignalTree <$> (ssSelectors signalSelector) + mapM_ (\x -> x element newSignalTree) rebuilds -- write the data to the IORef so that the getters get the right stuff IORef.writeIORef (ePlotValueRef element) datalog diff --git a/src/PlotHo/SignalSelector.hs b/src/PlotHo/SignalSelector.hs index ba7c303..4187058 100644 --- a/src/PlotHo/SignalSelector.hs +++ b/src/PlotHo/SignalSelector.hs @@ -5,6 +5,7 @@ module PlotHo.SignalSelector ( SignalSelector(..) + , Selector(..) , newSignalSelectorArea , newMultiSignalSelectorArea , gettersAndTitle @@ -25,16 +26,20 @@ import System.Glib.UTFString ( DefaultGlibString ) import PlotHo.PlotTypes -data SignalSelector +data SignalSelector a = SignalSelector { ssTreeView :: Gtk.TreeView - , ssRebuildSignalTree :: forall a . Element' a -> SignalTree a -> IO () - , ssToPlotValues :: IO (Maybe String, [(String, [[(Double, Double)]])]) + , ssSelectors :: a } -newMultiSignalSelectorArea :: [Element] -> Int -> IO SignalSelector +data Selector + = Selector + { sRebuildSignalTree :: forall a . Element' a -> SignalTree a -> IO () + , sToPlotValues :: IO (Maybe String, [(String, [[(Double, Double)]])]) + } + +newMultiSignalSelectorArea :: [Element] -> Int -> IO (SignalSelector [Selector]) newMultiSignalSelectorArea elems numCols = do - graphInfoMVar <- CC.newMVar (Nothing, []) -- Be sure to get the # columns right or there will be a runtime error treeStore <- Gtk.treeStoreNew $ initialForest elems (numCols + 1) @@ -45,23 +50,30 @@ newMultiSignalSelectorArea elems numCols = do (setSignalAttrAndRender, _) <- signalColumn treeStore treeview "signal" -- add some columns - attrAndCol <- mapM (\n -> checkMarkColumn treeStore treeview ("Dummy!" ++ show n)) [1,2..numCols] + attrAndCol <- mapM (\n -> checkMarkColumn treeStore treeview ("Plot " ++ show n)) [1,2..numCols] let (setAttrAndRenders, columns) = unzip $ attrAndCol -- set the attributes sequence_ setAttrAndRenders setSignalAttrAndRender - --TODO(Rebecca) new update function - let updateGettersAndTitle' = updateGettersAndTitle graphInfoMVar treeStore treeview (head columns) + let toSelector :: Gtk.TreeViewColumn -> IO Selector + toSelector column = do + graphInfoMVar <- CC.newMVar (Nothing, []) + let updateGettersAndTitle' = updateGettersAndTitle graphInfoMVar treeStore treeview column + return $ + Selector + { sRebuildSignalTree = rebuildSignalTree treeStore updateGettersAndTitle' treeview + , sToPlotValues = toValues graphInfoMVar + } + selectors <- mapM toSelector columns - return + return $ SignalSelector { ssTreeView = treeview - , ssRebuildSignalTree = rebuildSignalTree treeStore updateGettersAndTitle' treeview - , ssToPlotValues = toValues graphInfoMVar + , ssSelectors = selectors } -newSignalSelectorArea :: [Element] -> IO () -> IO SignalSelector +newSignalSelectorArea :: [Element] -> IO () -> IO (SignalSelector Selector) newSignalSelectorArea elems redraw = do -- mvar with all the user input graphInfoMVar <- CC.newMVar (Nothing, []) @@ -95,8 +107,11 @@ newSignalSelectorArea elems redraw = do return SignalSelector { ssTreeView = treeview - , ssRebuildSignalTree = rebuildSignalTree treeStore updateGettersAndTitle' treeview - , ssToPlotValues = toValues graphInfoMVar + , ssSelectors = + Selector + { sRebuildSignalTree = rebuildSignalTree treeStore updateGettersAndTitle' treeview + , sToPlotValues = toValues graphInfoMVar + } } signalColumn :: forall a . Gtk.TreeViewClass a => Gtk.TreeStore ListViewInfo -> a -> String From 899b0ace79b5d33bd3c52047082c5b7c9966ee8a Mon Sep 17 00:00:00 2001 From: Rebecca Li Date: Mon, 26 Feb 2018 11:30:35 -0800 Subject: [PATCH 5/6] Multi signal selector with 3 plots --- Plot-ho-matic.cabal | 1 + src/PlotHo/GraphWidget.hs | 6 +- src/PlotHo/MultiSelectWidget.hs | 144 ++++++++++++++++++++++++++++++++ src/PlotHo/Plotter.hs | 80 +++--------------- src/PlotHo/SignalSelector.hs | 36 +++++--- 5 files changed, 184 insertions(+), 83 deletions(-) create mode 100644 src/PlotHo/MultiSelectWidget.hs diff --git a/Plot-ho-matic.cabal b/Plot-ho-matic.cabal index 2d92086..ce06351 100644 --- a/Plot-ho-matic.cabal +++ b/Plot-ho-matic.cabal @@ -30,6 +30,7 @@ library PlotHo.ChartRender PlotHo.HistoryChannel PlotHo.GraphWidget + PlotHo.MultiSelectWidget PlotHo.OptionsWidget PlotHo.Plotter PlotHo.PlotTypes diff --git a/src/PlotHo/GraphWidget.hs b/src/PlotHo/GraphWidget.hs index b92a5e4..98367a9 100644 --- a/src/PlotHo/GraphWidget.hs +++ b/src/PlotHo/GraphWidget.hs @@ -54,8 +54,8 @@ toElement' index channel = do -- make a new graph window -newGraph :: PlotterOptions -> [Channel] -> IO Gtk.Window -newGraph options channels = do +newGraph :: PlotterOptions -> [Channel] -> Maybe (SignalSelector Selector) -> IO Gtk.Window +newGraph options channels mSignalSelector = do win <- Gtk.windowNew elements <- zipWithM (\k (Channel c) -> Element <$> toElement' k c) [0..] channels @@ -87,7 +87,7 @@ newGraph options channels = do void $ CC.swapMVar needRedrawMVar True Gtk.postGUIAsync (Gtk.widgetQueueDraw chartCanvas) - signalSelector <- newSignalSelectorArea elements redraw + signalSelector <- newSignalSelectorArea elements redraw mSignalSelector largestRangeMVar <- CC.newMVar (XY defaultHistoryRange defaultHistoryRange) optionsWidget <- makeOptionsWidget options largestRangeMVar redraw diff --git a/src/PlotHo/MultiSelectWidget.hs b/src/PlotHo/MultiSelectWidget.hs new file mode 100644 index 0000000..64aa7e8 --- /dev/null +++ b/src/PlotHo/MultiSelectWidget.hs @@ -0,0 +1,144 @@ +{-# OPTIONS_GHC -Wall #-} +{-# Language ScopedTypeVariables #-} +{-# LANGUAGE PackageImports #-} + +module PlotHo.MultiSelectWidget + ( multiSelectWidget + ) where + +import Control.Monad ( unless, void, zipWithM ) +import Control.Monad.IO.Class ( liftIO ) +import qualified Control.Concurrent as CC +import Data.Default.Class ( def ) +import Data.Maybe ( fromMaybe ) +import qualified Data.IORef as IORef +import "gtk3" Graphics.UI.Gtk ( AttrOp( (:=) ) ) +import qualified "gtk3" Graphics.UI.Gtk as Gtk +import System.Exit ( exitFailure ) +import System.Glib.Signals ( on ) +import Prelude + +import PlotHo.GraphWidget ( newGraph, toElement' ) +import PlotHo.PlotTypes ( Channel(..), Element(..), Element'(..), PlotterOptions(..) ) +import PlotHo.SignalSelector ( SignalSelector(..), Selector(..), newMultiSignalSelectorArea ) + + +-- | fire up the the GUI +multiSelectWidget :: Maybe PlotterOptions -> [Channel] -> IO (CC.MVar [Gtk.Window]) +multiSelectWidget mplotterOptions channels = do + let plotterOptions = fromMaybe def mplotterOptions + + unless CC.rtsSupportsBoundThreads $ do + putStr $ unlines + [ "Plot-ho-matic requires the threaded RTS." + , "Please recompile your program with the -threaded GHC option." + , "Either add \"ghc-options: -threaded\" to your cabal file " + , "or use the -threaded flag when calling GHC from the command line." + ] + void exitFailure + + void Gtk.initGUI + + -- start the main window + win <- Gtk.windowNew + void $ Gtk.set win + [ Gtk.containerBorderWidth := 8 + , Gtk.windowTitle := "Plot-ho-matic Multi Selector Deluxe" + ] + + -- on close of main, kill all the windows and threads + graphWindowsToBeKilled <- CC.newMVar [] + CC.modifyMVar_ graphWindowsToBeKilled (return . (win:)) + + let killEverything :: IO () + killEverything = do + Gtk.mainQuit + void $ on win Gtk.deleteEvent $ liftIO (killEverything >> return False) + + --------------- main widget ----------------- + + -- Multi Signal Selector + elements <- zipWithM (\k (Channel c) -> Element <$> toElement' k c) [0..] channels + multiSignalSelector <- newMultiSignalSelectorArea elements 3 + + -- refresh signal selector + buttonRefresh <- Gtk.buttonNewWithLabel "refresh" + void $ on buttonRefresh Gtk.buttonActivated (rebuildSignals elements multiSignalSelector) + + buttonSpawnPrefilledGraphs <- Gtk.buttonNewWithLabel "gen prefilled graphs" + void $ on buttonSpawnPrefilledGraphs Gtk.buttonActivated $ do + let genGraph selector = do + let signalSelector = + SignalSelector + { ssTreeView = ssTreeView multiSignalSelector + , ssTreeStore = ssTreeStore multiSignalSelector + , ssSelectors = selector + } + graphWin <- newGraph plotterOptions channels (Just signalSelector) + -- add this window to the list to be killed on exit + CC.modifyMVar_ graphWindowsToBeKilled (return . (graphWin:)) + + mapM_ genGraph (ssSelectors multiSignalSelector) + Gtk.mainQuit + Gtk.widgetDestroy win + + treeviewScroll <- Gtk.scrolledWindowNew Nothing Nothing + Gtk.set treeviewScroll [Gtk.widgetVExpand := True] -- make sure it expands vertically + Gtk.containerAdd treeviewScroll (ssTreeView multiSignalSelector) + Gtk.set treeviewScroll + [ Gtk.scrolledWindowHscrollbarPolicy := Gtk.PolicyNever + , Gtk.scrolledWindowVscrollbarPolicy := Gtk.PolicyAutomatic + ] + treeviewExpander <- Gtk.expanderNew "sig" + Gtk.set treeviewExpander + [ Gtk.containerChild := treeviewScroll + , Gtk.expanderExpanded := True + ] + + -- vbox to hold everything + vbox <- Gtk.vBoxNew False 4 + Gtk.set vbox $ + [ Gtk.containerChild := buttonSpawnPrefilledGraphs + , Gtk.boxChildPacking buttonSpawnPrefilledGraphs := Gtk.PackNatural + , Gtk.containerChild := buttonRefresh + , Gtk.boxChildPacking buttonRefresh := Gtk.PackNatural + , Gtk.containerChild := treeviewExpander + , Gtk.boxChildPacking treeviewExpander := Gtk.PackGrow + ] + + void $ Gtk.widgetSetSizeRequest vbox 20 200 + + -- add widget to window and show + void $ Gtk.set win [ Gtk.containerChild := vbox ] + Gtk.widgetShowAll win + Gtk.mainGUI + -- Pass graphs back to main program + return graphWindowsToBeKilled + +rebuildSignals :: [Element] -> SignalSelector [Selector] -> IO () +rebuildSignals elements signalSelector = do + let stageDataFromElement :: forall a . Element' a -> IO () + stageDataFromElement element = do + let msgStore = eMsgStore element + -- get the latest data, just block if they're not available + mdatalog <- CC.takeMVar msgStore + case mdatalog of + -- no data yet, do nothing + Nothing -> CC.putMVar msgStore mdatalog + Just (datalog, msignalTree) -> do + case msignalTree of + -- No new signal tree, no action necessary + Nothing -> return () + -- If there is a new signal tree, we have to merge it with the old one. + Just newSignalTree -> do + let rebuilds = sRebuildSignalTree <$> (ssSelectors signalSelector) + mapM_ (\x -> x element newSignalTree) rebuilds + + -- write the data to the IORef so that the getters get the right stuff + IORef.writeIORef (ePlotValueRef element) datalog + + -- Put the data back. Put Nothing to signify that the signal tree is up to date. + CC.putMVar msgStore (Just (datalog, Nothing)) + + -- stage the values + mapM_ (\(Element e) -> stageDataFromElement e) elements \ No newline at end of file diff --git a/src/PlotHo/Plotter.hs b/src/PlotHo/Plotter.hs index 54e3e56..ba7247e 100644 --- a/src/PlotHo/Plotter.hs +++ b/src/PlotHo/Plotter.hs @@ -8,7 +8,7 @@ module PlotHo.Plotter import qualified GHC.Stats -import Control.Monad ( unless, void, zipWithM ) +import Control.Monad ( unless, void, ) import Control.Monad.IO.Class ( MonadIO(..) ) import qualified Control.Concurrent as CC import Data.Default.Class ( def ) @@ -22,9 +22,9 @@ import System.Exit ( exitFailure ) import System.Glib.Signals ( on ) import Prelude -import PlotHo.GraphWidget ( newGraph, toElement' ) -import PlotHo.PlotTypes ( Channel(..), Channel'(..), Element(..), Element'(..), PlotterOptions(..) ) -import PlotHo.SignalSelector ( SignalSelector(..), Selector(..), newMultiSignalSelectorArea ) +import PlotHo.GraphWidget ( newGraph ) +import PlotHo.PlotTypes ( Channel(..), Channel'(..), PlotterOptions(..) ) +import PlotHo.MultiSelectWidget ( multiSelectWidget ) -- | fire up the the GUI runPlotter :: Maybe PlotterOptions -> [Channel] -> IO () @@ -78,37 +78,16 @@ runPlotter mplotterOptions channels = do -- button to spawn a new graph buttonSpawnGraph <- Gtk.buttonNewWithLabel "new graph" void $ on buttonSpawnGraph Gtk.buttonActivated $ do - graphWin <- newGraph plotterOptions channels + graphWin <- newGraph plotterOptions channels Nothing -- add this window to the list to be killed on exit CC.modifyMVar_ graphWindowsToBeKilled (return . (graphWin:)) - buttonSpawnPrefilledGraphs <- Gtk.buttonNewWithLabel "gen prefilled graphs" - void $ on buttonSpawnPrefilledGraphs Gtk.buttonActivated $ do - putStrLn "dummy button" --TODO(Rebecca) - -- graphWin <- newGraph plotterOptions channels - -- add this window to the list to be killed on exit - -- CC.modifyMVar_ graphWindowsToBeKilled (return . (graphWin:)) - - -- Multi Signal Selector - elements <- zipWithM (\k (Channel c) -> Element <$> toElement' k c) [0..] channels - multiSignalSelector <- newMultiSignalSelectorArea elements 3 - - -- refresh signal selector - buttonRefresh <- Gtk.buttonNewWithLabel "refresh" - void $ on buttonRefresh Gtk.buttonActivated (rebuildSignals elements multiSignalSelector) - - treeviewScroll <- Gtk.scrolledWindowNew Nothing Nothing - Gtk.set treeviewScroll [Gtk.widgetVExpand := True] -- make sure it expands vertically - Gtk.containerAdd treeviewScroll (ssTreeView multiSignalSelector) - Gtk.set treeviewScroll - [ Gtk.scrolledWindowHscrollbarPolicy := Gtk.PolicyNever - , Gtk.scrolledWindowVscrollbarPolicy := Gtk.PolicyAutomatic - ] - treeviewExpander <- Gtk.expanderNew "sig" - Gtk.set treeviewExpander - [ Gtk.containerChild := treeviewScroll - , Gtk.expanderExpanded := True - ] + -- multi signal selector + buttonMultiSelector <- Gtk.buttonNewWithLabel "multigraph" + void $ on buttonMultiSelector Gtk.buttonActivated $ do + mVarMoreGraphsToKill <- multiSelectWidget mplotterOptions channels + moreGraphsToKill <- CC.readMVar mVarMoreGraphsToKill + CC.modifyMVar_ graphWindowsToBeKilled (return . (moreGraphsToKill++)) -- clear history / max history widget for each channel chanWidgets <- mapM (\(Channel c) -> newChannelWidget c) channels @@ -134,12 +113,8 @@ runPlotter mplotterOptions channels = do , Gtk.boxChildPacking statsLabel := Gtk.PackNatural , Gtk.containerChild := buttonSpawnGraph , Gtk.boxChildPacking buttonSpawnGraph := Gtk.PackNatural - , Gtk.containerChild := buttonSpawnPrefilledGraphs - , Gtk.boxChildPacking buttonSpawnPrefilledGraphs := Gtk.PackNatural - , Gtk.containerChild := buttonRefresh - , Gtk.boxChildPacking buttonRefresh := Gtk.PackNatural - , Gtk.containerChild := treeviewExpander - , Gtk.boxChildPacking treeviewExpander := Gtk.PackGrow + , Gtk.containerChild := buttonMultiSelector + , Gtk.boxChildPacking buttonMultiSelector := Gtk.PackNatural , Gtk.containerChild := scroll ] @@ -150,35 +125,6 @@ runPlotter mplotterOptions channels = do Gtk.widgetShowAll win Gtk.mainGUI -rebuildSignals :: [Element] -> SignalSelector [Selector] -> IO () -rebuildSignals elements signalSelector = do - let stageDataFromElement :: forall a . Element' a -> IO () - stageDataFromElement element = do - let msgStore = eMsgStore element - -- get the latest data, just block if they're not available - mdatalog <- CC.takeMVar msgStore - case mdatalog of - -- no data yet, do nothing - Nothing -> CC.putMVar msgStore mdatalog - Just (datalog, msignalTree) -> do - case msignalTree of - -- No new signal tree, no action necessary - Nothing -> return () - -- If there is a new signal tree, we have to merge it with the old one. - Just newSignalTree -> do - let rebuilds = sRebuildSignalTree <$> (ssSelectors signalSelector) - mapM_ (\x -> x element newSignalTree) rebuilds - - -- write the data to the IORef so that the getters get the right stuff - IORef.writeIORef (ePlotValueRef element) datalog - - -- Put the data back. Put Nothing to signify that the signal tree is up to date. - CC.putMVar msgStore (Just (datalog, Nothing)) - - -- stage the values - mapM_ (\(Element e) -> stageDataFromElement e) elements - - -- the list of channels newChannelWidget :: Channel' a -> IO Gtk.VBox newChannelWidget channel = do diff --git a/src/PlotHo/SignalSelector.hs b/src/PlotHo/SignalSelector.hs index 4187058..ba7a793 100644 --- a/src/PlotHo/SignalSelector.hs +++ b/src/PlotHo/SignalSelector.hs @@ -29,6 +29,7 @@ import PlotHo.PlotTypes data SignalSelector a = SignalSelector { ssTreeView :: Gtk.TreeView + , ssTreeStore :: Gtk.TreeStore ListViewInfo , ssSelectors :: a } @@ -36,6 +37,7 @@ data Selector = Selector { sRebuildSignalTree :: forall a . Element' a -> SignalTree a -> IO () , sToPlotValues :: IO (Maybe String, [(String, [[(Double, Double)]])]) + , sColumnNumber :: Int -- ^ must be assigned after tree is built - a bit hacky :( } newMultiSignalSelectorArea :: [Element] -> Int -> IO (SignalSelector [Selector]) @@ -59,26 +61,32 @@ newMultiSignalSelectorArea elems numCols = do let toSelector :: Gtk.TreeViewColumn -> IO Selector toSelector column = do graphInfoMVar <- CC.newMVar (Nothing, []) - let updateGettersAndTitle' = updateGettersAndTitle graphInfoMVar treeStore treeview column + colNum <- getColumnNumber treeview column + let updateGettersAndTitle' = updateGettersAndTitle graphInfoMVar treeStore colNum return $ Selector { sRebuildSignalTree = rebuildSignalTree treeStore updateGettersAndTitle' treeview , sToPlotValues = toValues graphInfoMVar + , sColumnNumber = colNum } selectors <- mapM toSelector columns return $ SignalSelector { ssTreeView = treeview + , ssTreeStore = treeStore , ssSelectors = selectors } -newSignalSelectorArea :: [Element] -> IO () -> IO (SignalSelector Selector) -newSignalSelectorArea elems redraw = do +newSignalSelectorArea :: [Element] -> IO () + -> Maybe (SignalSelector Selector) + -> IO (SignalSelector Selector) +newSignalSelectorArea elems redraw mSigSelector = do -- mvar with all the user input graphInfoMVar <- CC.newMVar (Nothing, []) - - treeStore <- Gtk.treeStoreNew $ initialForest elems 2 + treeStore <- case (ssTreeStore <$> mSigSelector) of + Just t -> return t + Nothing -> Gtk.treeStoreNew $ initialForest elems 2 treeview <- Gtk.treeViewNewWithModel treeStore Gtk.treeViewSetHeadersVisible treeview True @@ -93,11 +101,13 @@ newSignalSelectorArea elems redraw = do Gtk.treeViewColumnSetTitle colVisible "visible?" rendererVisible <- Gtk.cellRendererToggleNew Gtk.treeViewColumnPackStart colVisible rendererVisible True - let updateGettersAndTitle' = updateGettersAndTitle graphInfoMVar treeStore treeview colVisible appendColumn treeview colVisible -- Now, we can set the attributes and render since the order of the columns is set. - colVisibleNumber <- getColumnNumber treeview colVisible + colVisibleNumber <- case ((sColumnNumber . ssSelectors) <$> mSigSelector) of + Nothing -> getColumnNumber treeview colVisible + Just i -> return i + let updateGettersAndTitle' = updateGettersAndTitle graphInfoMVar treeStore colVisibleNumber Gtk.cellLayoutSetAttributes colVisible rendererVisible treeStore $ \lvi -> (markedAttribute colVisibleNumber lvi) setSignalAttrAndRender @@ -107,10 +117,12 @@ newSignalSelectorArea elems redraw = do return SignalSelector { ssTreeView = treeview + , ssTreeStore = treeStore , ssSelectors = Selector { sRebuildSignalTree = rebuildSignalTree treeStore updateGettersAndTitle' treeview , sToPlotValues = toValues graphInfoMVar + , sColumnNumber = colVisibleNumber } } @@ -151,7 +163,7 @@ checkMarkColumn treeStore treeview columnName = do appendColumn :: forall a . Gtk.TreeViewClass a => a -> Gtk.TreeViewColumn -> IO () appendColumn treeview col = do void $ Gtk.treeViewAppendColumn treeview col - --TODO(rebecca): append proper number of columns to lvi + --TODO(rebecca): append proper number of columns to lvi? maybe initialForest :: [Element] -> Int -> [Tree ListViewInfo] @@ -298,17 +310,15 @@ getChildrenFuns treeStore = (getChildrenPaths, changeSelfAndChildren) mapM_ (changeSelfAndChildren change) childrenPaths -- traverse the whole graph and update the list of getters and the title -updateGettersAndTitle :: forall a . Gtk.TreeViewClass a - => CC.MVar (Maybe String, [(String, IO [[(Double, Double)]])]) - -> Gtk.TreeStore ListViewInfo -> a -> Gtk.TreeViewColumn -> IO () -updateGettersAndTitle graphInfoMVar treeStore treeview colVisible = do +updateGettersAndTitle :: CC.MVar (Maybe String, [(String, IO [[(Double, Double)]])]) + -> Gtk.TreeStore ListViewInfo -> Int -> IO () +updateGettersAndTitle graphInfoMVar treeStore colNum = do -- first get all trees let getTrees k = do tree' <- Gtk.treeStoreLookup treeStore [k] case tree' of Nothing -> return [] Just tree -> fmap (tree:) (getTrees (k+1)) theTrees <- getTrees 0 - colNum <- getColumnNumber treeview colVisible let newGetters0 :: [([String], IO [[(Double, Double)]])] newGetters0 = zip names (gots <$> goodLvis) where From 120c8f18a222e6777d90a440c6956a8b6d9cbfb5 Mon Sep 17 00:00:00 2001 From: Rebecca Li Date: Mon, 26 Feb 2018 11:53:16 -0800 Subject: [PATCH 6/6] Added option to select number of multigraphs --- src/PlotHo/MultiSelectWidget.hs | 6 +++--- src/PlotHo/Plotter.hs | 38 ++++++++++++++++++++++++++++----- 2 files changed, 36 insertions(+), 8 deletions(-) diff --git a/src/PlotHo/MultiSelectWidget.hs b/src/PlotHo/MultiSelectWidget.hs index 64aa7e8..c3162fe 100644 --- a/src/PlotHo/MultiSelectWidget.hs +++ b/src/PlotHo/MultiSelectWidget.hs @@ -24,8 +24,8 @@ import PlotHo.SignalSelector ( SignalSelector(..), Selector(..), newMultiSignalS -- | fire up the the GUI -multiSelectWidget :: Maybe PlotterOptions -> [Channel] -> IO (CC.MVar [Gtk.Window]) -multiSelectWidget mplotterOptions channels = do +multiSelectWidget :: Maybe PlotterOptions -> [Channel] -> Int -> IO (CC.MVar [Gtk.Window]) +multiSelectWidget mplotterOptions channels numGraphs = do let plotterOptions = fromMaybe def mplotterOptions unless CC.rtsSupportsBoundThreads $ do @@ -59,7 +59,7 @@ multiSelectWidget mplotterOptions channels = do -- Multi Signal Selector elements <- zipWithM (\k (Channel c) -> Element <$> toElement' k c) [0..] channels - multiSignalSelector <- newMultiSignalSelectorArea elements 3 + multiSignalSelector <- newMultiSignalSelectorArea elements numGraphs -- refresh signal selector buttonRefresh <- Gtk.buttonNewWithLabel "refresh" diff --git a/src/PlotHo/Plotter.hs b/src/PlotHo/Plotter.hs index ba7247e..84e1776 100644 --- a/src/PlotHo/Plotter.hs +++ b/src/PlotHo/Plotter.hs @@ -83,11 +83,39 @@ runPlotter mplotterOptions channels = do CC.modifyMVar_ graphWindowsToBeKilled (return . (graphWin:)) -- multi signal selector + -- set the number of graphs + numGraphsLabel <- Gtk.vBoxNew False 4 >>= labeledWidget "num graphs:" + numGraphsEntry <- Gtk.entryNew + Gtk.set numGraphsEntry + [ Gtk.entryEditable := True + , Gtk.widgetSensitive := True + ] + Gtk.entrySetText numGraphsEntry "3" + let makeMultiGraphs = do + txt <- Gtk.get numGraphsEntry Gtk.entryText + case readMaybe txt :: Maybe Int of + Nothing -> + putStrLn ("num graphs: couldn't make an Int out of \"" ++ show txt ++ "\"") + Just 0 -> putStrLn "numGraphs: must be greater than 0" + Just k -> do + mVarMoreGraphsToKill <- multiSelectWidget mplotterOptions channels k + moreGraphsToKill <- CC.readMVar mVarMoreGraphsToKill + CC.modifyMVar_ graphWindowsToBeKilled (return . (moreGraphsToKill++)) + + -- make the button buttonMultiSelector <- Gtk.buttonNewWithLabel "multigraph" void $ on buttonMultiSelector Gtk.buttonActivated $ do - mVarMoreGraphsToKill <- multiSelectWidget mplotterOptions channels - moreGraphsToKill <- CC.readMVar mVarMoreGraphsToKill - CC.modifyMVar_ graphWindowsToBeKilled (return . (moreGraphsToKill++)) + makeMultiGraphs + + hboxMultiSelector <- Gtk.hBoxNew False 4 + Gtk.set hboxMultiSelector + [ Gtk.containerChild := numGraphsLabel + , Gtk.boxChildPacking numGraphsLabel := Gtk.PackNatural + , Gtk.containerChild := numGraphsEntry + , Gtk.boxChildPacking numGraphsEntry := Gtk.PackNatural + , Gtk.containerChild := buttonMultiSelector + , Gtk.boxChildPacking buttonMultiSelector := Gtk.PackGrow + ] -- clear history / max history widget for each channel chanWidgets <- mapM (\(Channel c) -> newChannelWidget c) channels @@ -113,8 +141,8 @@ runPlotter mplotterOptions channels = do , Gtk.boxChildPacking statsLabel := Gtk.PackNatural , Gtk.containerChild := buttonSpawnGraph , Gtk.boxChildPacking buttonSpawnGraph := Gtk.PackNatural - , Gtk.containerChild := buttonMultiSelector - , Gtk.boxChildPacking buttonMultiSelector := Gtk.PackNatural + , Gtk.containerChild := hboxMultiSelector + , Gtk.boxChildPacking hboxMultiSelector := Gtk.PackNatural , Gtk.containerChild := scroll ]