Plot-ho-matic 0.5.0.0 → 0.5.0.1
raw patch · 7 files changed
+158/−40 lines, 7 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- .travis.yml +1/−1
- CHANGELOG.md +5/−0
- Plot-ho-matic.cabal +2/−2
- examples/Example.hs +18/−15
- src/PlotHo.hs +6/−4
- src/PlotHo/GraphWidget.hs +119/−17
- src/PlotHo/PlotTypes.hs +7/−1
.travis.yml view
@@ -1,7 +1,7 @@ # from https://github.com/hvr/multi-ghc-travis env:- - GHCVER=7.6.3+# - GHCVER=7.6.3 # todo: re-enable this - GHCVER=7.8.3 # see note about Alex/Happy before_install:
CHANGELOG.md view
@@ -26,3 +26,8 @@ * Major performance improvements (only draw new data) * Both "history" and custom plot interfaces * Unify this package with the dynobud plotter++0.5.0.1+---+* Hierarchical visibility clicking and inconsistent state+* Merge new signal tree with old
Plot-ho-matic.cabal view
@@ -1,5 +1,5 @@ name: Plot-ho-matic-version: 0.5.0.0+version: 0.5.0.1 synopsis: Real-time line plotter for protobuf-like data license: BSD3 license-file: LICENSE@@ -61,5 +61,5 @@ , Plot-ho-matic , containers - ghc-options: -O2+ ghc-options: -O2 -with-rtsopts=-T ghc-prof-options: -O2 -Wall -prof -fprof-auto -fprof-cafs -rtsopts
examples/Example.hs view
@@ -9,36 +9,39 @@ import PlotHo ( Lookup, XAxisType(..), runPlotter, addHistoryChannel ) -data Xyz = MkXyz { x :: Double- , y :: Double- , z :: Double- } deriving Generic+data Xyz a = MkXyz { x :: Double+ , y :: Double+ , z :: Double+ , zz :: a+ } deriving Generic data Axyz = MkAxyz { lol :: Double -- , xyzList :: S.Seq Xyz- , xyz :: Xyz+ , xyz1 :: Xyz (Xyz (Xyz Double))+ , xyz2 :: Xyz Double } deriving Generic-instance Lookup Xyz+instance Lookup a => Lookup (Xyz a) instance Lookup Axyz axyz0 :: Axyz axyz0 = MkAxyz 7 -- (S.fromList [MkXyz 1 2 3])- (MkXyz 1 2 3)+ (MkXyz 1 2 3 (MkXyz 4 5 6 (MkXyz 7 8 9 10)))+ (MkXyz 1 2 3 4) -xyz0 :: Xyz-xyz0 = MkXyz 1 2 3+xyz0 :: Xyz Double+xyz0 = MkXyz 1 2 3 0.1 incrementAxyz :: Axyz -> Axyz-incrementAxyz (MkAxyz a _) = MkAxyz+incrementAxyz (MkAxyz a _ _) = MkAxyz (a+0.2)--- (S.take 5 (xyz <| xyzs))- xyz'+ (xyz' (xyz' (xyz' (sin (3*a)))))+ (xyz' (sin (2*a))) where- xyz' = MkXyz (sin a) (cos a) (sin a * cos a)+ xyz' w = MkXyz (sin a) (cos a) (sin a * cos a) w -incrementXyz :: Xyz -> Xyz-incrementXyz (MkXyz a _ _) = MkXyz (a+0.3) (2 * sin a) (3 * cos a)+incrementXyz :: Xyz a -> Xyz a+incrementXyz (MkXyz a _ _ b) = MkXyz (a+0.3) (2 * sin a) (3 * cos a) b -- a random function to write a bunch of data to a chan channelWriter :: Int -> Int -> (a -> a) -> a -> (a -> Bool -> IO ()) -> IO ()
src/PlotHo.hs view
@@ -321,15 +321,17 @@ -- button to clear history buttonAlsoDoNothing <- Gtk.buttonNewWithLabel "also do nothing"- _ <- Gtk.onClicked buttonAlsoDoNothing $ do- putStrLn "i promise, nothing happens"- -- CC.modifyMVar_ logData (const (return S.empty))- return ()+-- _ <- Gtk.onClicked buttonAlsoDoNothing $ do+-- putStrLn "i promise, nothing happens"+-- -- CC.modifyMVar_ logData (const (return S.empty))+-- return ()+ let triggerYo action = Gtk.onClicked buttonAlsoDoNothing action >> return () -- button to make a new graph buttonNew <- Gtk.buttonNewWithLabel "new graph" _ <- Gtk.onClicked buttonNew $ do graphWin <- newGraph+ triggerYo (chanName channel) (chanSameSignalTree channel) (chanToSignalTree channel)
src/PlotHo/GraphWidget.hs view
@@ -8,6 +8,7 @@ import qualified Control.Concurrent as CC import Control.Monad ( when, unless ) import qualified Data.IORef as IORef+import qualified Data.Map as M import Data.Maybe ( isJust, fromJust ) import qualified Data.Tree as Tree import Graphics.UI.Gtk ( AttrOp( (:=) ) )@@ -18,16 +19,17 @@ import qualified Graphics.Rendering.Chart as Chart import PlotHo.PlotChart ( AxisScaling(..), displayChart, chartGtkUpdateCanvas )-import PlotHo.PlotTypes ( GraphInfo(..), ListViewInfo(..) )+import PlotHo.PlotTypes ( GraphInfo(..), ListViewInfo(..), MarkedState(..) ) -- make a new graph window newGraph :: forall a- . String+ . (IO () -> IO ())+ -> String -> (a -> a -> Bool) -> (a -> [Tree.Tree (String, String, Maybe (a -> [[(Double, Double)]]))]) -> Gtk.ListStore a -> IO Gtk.Window-newGraph channame sameSignalTree forestFromMeta msgStore = do+newGraph onButton channame sameSignalTree forestFromMeta msgStore = do win <- Gtk.windowNew _ <- Gtk.set win [ Gtk.containerBorderWidth := 8@@ -77,7 +79,7 @@ -- the signal selector- treeview' <- newSignalSelectorArea sameSignalTree forestFromMeta graphInfoMVar msgStore redraw+ treeview' <- newSignalSelectorArea onButton sameSignalTree forestFromMeta graphInfoMVar msgStore redraw treeview <- Gtk.expanderNew "signals" Gtk.set treeview [ Gtk.containerChild := treeview' , Gtk.expanderExpanded := True@@ -108,12 +110,13 @@ newSignalSelectorArea :: forall a- . (a -> a -> Bool)+ . (IO () -> IO ())+ -> (a -> a -> Bool) -> (a -> [Tree.Tree (String, String, Maybe (a -> [[(Double, Double)]]))]) -> CC.MVar (GraphInfo a) -> Gtk.ListStore a -> IO () -> IO Gtk.ScrolledWindow-newSignalSelectorArea sameSignalTree forestFromMeta graphInfoMVar msgStore redraw = do+newSignalSelectorArea onButton sameSignalTree forestFromMeta graphInfoMVar msgStore redraw = do treeStore <- Gtk.treeStoreNew [] treeview <- Gtk.treeViewNewWithModel treeStore @@ -137,8 +140,18 @@ showName Nothing name typeName = name ++ " (" ++ typeName ++ ")" Gtk.cellLayoutSetAttributes col1 renderer1 treeStore $ \(ListViewInfo {lviName = name, lviType = typeName, lviGetter = getter}) ->- [ Gtk.cellText := showName getter name typeName]- Gtk.cellLayoutSetAttributes col2 renderer2 treeStore $ \lvi -> [ Gtk.cellToggleActive := lviMarked lvi]+ [ Gtk.cellText := showName getter name typeName+ ]+ Gtk.cellLayoutSetAttributes col2 renderer2 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+ ] _ <- Gtk.treeViewAppendColumn treeview col1 _ <- Gtk.treeViewAppendColumn treeview col2@@ -154,37 +167,121 @@ theTrees <- getTrees 0 let newGetters = [ (lviName lvi, fromJust $ lviGetter lvi) | lvi <- concatMap Tree.flatten theTrees- , lviMarked lvi+ , lviMarked lvi == On , isJust (lviGetter lvi) ] _ <- CC.modifyMVar_ graphInfoMVar (\gi0 -> return $ gi0 { giGetters = newGetters }) return () + 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+ -- update which y axes are visible _ <- on renderer2 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- let g lvi@(ListViewInfo _ _ Nothing _) = lvi- g lvi = lvi {lviMarked = not (lviMarked lvi)}- ret <- Gtk.treeStoreChange treeStore treePath g- unless ret $ putStrLn "treeStoreChange fail"+ val <- Gtk.treeStoreGetValue treeStore treePath+ case val of+ (ListViewInfo _ _ Nothing Off) ->+ changeSelfAndChildren (\lvi -> lvi {lviMarked = On}) treePath+ (ListViewInfo _ _ Nothing On) ->+ changeSelfAndChildren (\lvi -> lvi {lviMarked = Off}) treePath+ (ListViewInfo _ _ Nothing Inconsistent) ->+ changeSelfAndChildren (\lvi -> lvi {lviMarked = On}) treePath+ lvi@(ListViewInfo _ _ (Just _) On) ->+ Gtk.treeStoreSetValue treeStore treePath $ lvi {lviMarked = Off}+ lvi@(ListViewInfo _ _ (Just _) Off) ->+ Gtk.treeStoreSetValue treeStore treePath $ lvi {lviMarked = On}+ (ListViewInfo _ _ (Just _) Inconsistent) -> error "cell getter can't be inconsistent"++ fixInconsistent treePath updateGraphInfo redraw + let getTopForest = do+ nTopLevelNodes <- Gtk.treeModelIterNChildren treeStore Nothing+ mnodes <- mapM (Gtk.treeModelIterNthChild treeStore Nothing) (take nTopLevelNodes [0..])+ let treeFromJust (Just x) = i2p x >>= Gtk.treeStoreGetTree treeStore+ treeFromJust Nothing = error "missing top level node"+ mapM treeFromJust mnodes -- rebuild the signal tree let rebuildSignalTree :: [Tree.Tree (String, String, Maybe (a -> [[(Double, Double)]]))] -> IO () rebuildSignalTree meta = do- let mkTreeNode (name,typeName,maybeget) = ListViewInfo name typeName maybeget False- newTrees :: [Tree.Tree (ListViewInfo a)]- newTrees = map (fmap mkTreeNode) meta+ putStrLn "rebuilding signal tree"++ oldTrees <- getTopForest+ let _ = oldTrees :: [Tree.Tree (ListViewInfo a)]++ merge :: forall b+ . [Tree.Tree (ListViewInfo b)]+ -> [Tree.Tree (String, String, Maybe (a -> [[(Double, Double)]]))]+ -> [Tree.Tree (ListViewInfo a)]+ merge old new = map convert new+ where+ oldMap :: M.Map (String, String) (ListViewInfo b, [Tree.Tree (ListViewInfo b)])+ oldMap = M.fromList $+ map (\(Tree.Node lvi lvis) -> ((lviName lvi, lviType lvi), (lvi, lvis))) old++ convert :: Tree.Tree (String, String, Maybe (a -> [[(Double, Double)]]))+ -> Tree.Tree (ListViewInfo a)+ convert (Tree.Node (name,typ, getter) others) = case M.lookup (name,typ) oldMap of+ Nothing -> Tree.Node (ListViewInfo name typ getter Off) (merge [] others)+ Just (lvi, oldOthers) -> Tree.Node (ListViewInfo name typ getter (lviMarked lvi)) (merge oldOthers others)++ newTrees = merge oldTrees meta+ Gtk.treeStoreClear treeStore Gtk.treeStoreInsertForest treeStore [] 0 newTrees updateGraphInfo oldMetaRef <- IORef.newIORef Nothing- let maybeRebuildSignalTree newMeta = do+ let maybeRebuildSignalTree :: a -> IO ()+ maybeRebuildSignalTree newMeta = do oldMeta <- IORef.readIORef oldMetaRef let sameSignalTree' Nothing _ = False sameSignalTree' (Just x) y = sameSignalTree x y@@ -205,6 +302,11 @@ when (size > 0) $ do newMsg <- Gtk.listStoreGetValue msgStore 0 maybeRebuildSignalTree newMsg >> redraw++ -- for debugging+ onButton $ do+ newMsg <- Gtk.listStoreGetValue msgStore 0+ rebuildSignalTree (forestFromMeta newMsg) >> redraw scroll <- Gtk.scrolledWindowNew Nothing Nothing
src/PlotHo/PlotTypes.hs view
@@ -7,19 +7,25 @@ , GraphInfo(..) , ListViewInfo(..) , AxisScaling(..)+ , MarkedState(..) ) where import Data.Tree ( Tree ) import qualified Graphics.UI.Gtk as Gtk import Data.IORef ( IORef ) +data MarkedState =+ On | Off | Inconsistent deriving (Eq, Show)+ data ListViewInfo a = ListViewInfo { lviName :: String , lviType :: String , lviGetter :: Maybe (a -> [[(Double,Double)]])- , lviMarked :: Bool+ , lviMarked :: MarkedState }+instance Show (ListViewInfo a) where+ show (ListViewInfo n t _ m) = "ListViewInfo " ++ show (n,t,m) data AxisScaling = LogScaling | LinearScaling