Multi Signal selector

Plot-ho-matic.cabal

@@ -30,6 +30,7 @@ library
                      PlotHo.ChartRender
                      PlotHo.HistoryChannel
                      PlotHo.GraphWidget
+                     PlotHo.MultiSelectWidget
                      PlotHo.OptionsWidget
                      PlotHo.Plotter
                      PlotHo.PlotTypes

src/PlotHo/GraphWidget.hs

@@ -4,6 +4,7 @@
 
 module PlotHo.GraphWidget
        ( newGraph
+       , toElement'
        ) where
 
 import Control.Concurrent ( MVar )
@@ -25,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)
@@ -53,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
@@ -86,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
@@ -143,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
@@ -158,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

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] -> Int -> IO (CC.MVar [Gtk.Window])
+multiSelectWidget mplotterOptions channels numGraphs = 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 numGraphs
+
+  -- 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

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
 

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,  )
 import Control.Monad.IO.Class ( MonadIO(..) )
 import qualified Control.Concurrent as CC
 import Data.Default.Class ( def )
@@ -24,6 +24,7 @@ import Prelude
 
 import PlotHo.GraphWidget ( newGraph )
 import PlotHo.PlotTypes ( Channel(..), Channel'(..), PlotterOptions(..) )
+import PlotHo.MultiSelectWidget ( multiSelectWidget )
 
 -- | fire up the the GUI
 runPlotter :: Maybe PlotterOptions -> [Channel] -> IO ()
@@ -77,10 +78,45 @@ 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:))
 
+  -- 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
+    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
 
@@ -105,6 +141,8 @@ runPlotter mplotterOptions channels = do
     , Gtk.boxChildPacking statsLabel := Gtk.PackNatural
     , Gtk.containerChild := buttonSpawnGraph
     , Gtk.boxChildPacking buttonSpawnGraph := Gtk.PackNatural
+    , Gtk.containerChild := hboxMultiSelector
+    , Gtk.boxChildPacking hboxMultiSelector := Gtk.PackNatural
     , Gtk.containerChild := scroll
     ]
 
@@ -115,9 +153,6 @@ runPlotter mplotterOptions channels = do
   Gtk.widgetShowAll win
   Gtk.mainGUI
 
-
-
-
 -- the list of channels
 newChannelWidget :: Channel' a -> IO Gtk.VBox
 newChannelWidget channel = do