Plot-ho-matic 0.11.0.0 → 0.11.1.0

raw patch · 5 files changed

+68/−34 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Plot-ho-matic.cabal +1/−1
• examples/SetExample.hs +20/−17
• src/PlotHo/OptionsWidget.hs +7/−4
• src/PlotHo/SignalSelector.hs +2/−1
• src/SetHo.hs +38/−11

@@ -1,5 +1,5 @@ name:                Plot-ho-matic-version:             0.11.0.0+version:             0.11.1.0 synopsis:            Real-time line plotter for generic data license:             BSD3 license-file:        LICENSE

@@ -38,19 +38,19 @@  main :: IO () main = do-  upMsg <- CC.newEmptyMVar :: IO (CC.MVar (Maybe DTree))-  downMsg <- CC.newEmptyMVar :: IO (CC.MVar DTree)+  upMsg <- CC.newEmptyMVar :: IO (CC.MVar (Maybe (Int, DTree)))+  downMsg <- CC.newEmptyMVar :: IO (CC.MVar (Int, DTree))   counterVar <- CC.newMVar (0::Int)    let upstreamProcess = do-        upValue <- CC.newMVar (Left (initialFoo {foo2 = 999})) :: IO (CC.MVar (Either (Foo Bar) (Foo Int)))+        upValue <- CC.newMVar (0, Left (initialFoo {foo2 = 999})) :: IO (CC.MVar (Int, Either (Foo Bar) (Foo Int)))         let sendState = do-              x <- CC.readMVar upValue :: IO (Either (Foo Bar) (Foo Int))+              (k, x) <- CC.readMVar upValue :: IO (Int, Either (Foo Bar) (Foo Int))               putStrLn "                 upstream sending state"               let d = case x of                     Left r -> toDData r                     Right r -> toDData r-              CC.putMVar downMsg d+              CC.putMVar downMsg (k, d)          forever $ do           putStrLn "                 upstream waiting for message"@@ -64,45 +64,48 @@               putStrLn $ "                 upstream count: " ++ show count               when (mod count 3 == 0) $ do                 putStrLn "                 upstream swapping data"-                let swapData (Left _) = Right initialBar-                    swapData (Right _) = Left initialFoo+                let swapData (k, Left _) = (k, Right initialBar)+                    swapData (k, Right _) = (k, Left initialFoo)                 CC.modifyMVar_ upValue (return . swapData)               sendState-            Just newDVal -> do+            Just (newK, newDVal) -> do               putStrLn "                 upstream got commit request"               CC.threadDelay 500000-              let modify (Left oldVal) = case updateLookupable oldVal newDVal of-                    Right newVal -> return (Left newVal)+              let modify (oldK, Left oldVal) = case updateLookupable oldVal newDVal of+                    Right newVal -> return (newK, Left newVal)                     Left err -> do                       putStrLn $                         "                 upstream got update error:\n" ++                         "                 " ++ err                       putStrLn "newDVal:"                       print newDVal-                      return (Left oldVal)-                  modify (Right oldVal) = case updateLookupable oldVal newDVal of-                    Right newVal -> return (Right newVal)+                      return (oldK, Left oldVal)+                  modify (oldK, Right oldVal) = case updateLookupable oldVal newDVal of+                    Right newVal -> return (newK, Right newVal)                     Left err -> do                       putStrLn $                         "                 upstream got update error:\n" ++                         "                 " ++ err-                      return (Right oldVal)+                      return (oldK, Right oldVal)                CC.modifyMVar_ upValue modify               sendState    void $ CC.forkIO upstreamProcess -  let refresh = do+  let refresh :: IO ()+      refresh = do         putStrLn "downstream sending refresh request"         CC.putMVar upMsg Nothing -      commit x = void $ do+      commit :: Int -> DTree -> IO ()+      commit k x = void $ do         putStrLn "downstream starting to commit"         CC.threadDelay 500000-        void $ CC.putMVar upMsg (Just x)+        void $ CC.putMVar upMsg (Just (k, x))         putStrLn "downstream finished commit" +      pollForNewMessage :: IO (Maybe (Int, DTree))       pollForNewMessage = do         mx <- CC.tryTakeMVar downMsg         case mx of

@@ -96,10 +96,13 @@   resetXHistoryButton <- Gtk.buttonNewWithLabel "reset X range"   resetYHistoryButton <- Gtk.buttonNewWithLabel "reset Y range" -  void $ on resetXHistoryButton Gtk.buttonActivated $-    CC.modifyMVar_ largestRangeMVar (\xy -> return (xy {xaxis = defaultHistoryRange}))-  void $ on resetYHistoryButton Gtk.buttonActivated $-    CC.modifyMVar_ largestRangeMVar (\xy -> return (xy {yaxis = defaultHistoryRange}))+  on resetXHistoryButton Gtk.buttonActivated $ do+    void $ CC.modifyMVar_ largestRangeMVar (\xy -> return (xy {xaxis = defaultHistoryRange}))+    redraw++  on resetYHistoryButton Gtk.buttonActivated $ do+    void $ CC.modifyMVar_ largestRangeMVar (\xy -> return (xy {yaxis = defaultHistoryRange}))+    redraw    -- vbox to hold the little window on the left   vbox <- Gtk.vBoxNew False 4

@@ -269,7 +269,8 @@     }  -+-- TODO(greg): tests+-- swashRotorCommands.c{ollective, yclicPitch, yclicRoll} -- The greatest common prefix will be the title. -- Everything after that is the field name. gettersAndTitle :: forall a . [([String], a)] -> ([(String, a)], Maybe String)

@@ -14,6 +14,7 @@ import qualified Control.Concurrent as CC import Control.Monad.IO.Class ( liftIO ) import qualified Data.ByteString.Lazy as BSL+import Data.IORef ( newIORef, readIORef, writeIORef ) import Data.Serialize ( encodeLazy, decodeLazy ) import "gtk3" Graphics.UI.Gtk ( AttrOp( (:=) ) ) import qualified "gtk3" Graphics.UI.Gtk as Gtk@@ -23,10 +24,13 @@ import SetHo.LookupTree ( newLookupTreeview )  -- | fire up the the GUI-runSetter :: String -> DTree -> IO (Maybe DTree) -> IO () -> (DTree -> IO ()) -> IO ()-runSetter rootName initialValue userPollForNewMessage sendRequest commit = do+runSetter :: String -> DTree -> IO (Maybe (Int, DTree)) -> IO () -> (Int -> DTree -> IO ()) -> IO ()+runSetter rootName initialValue userPollForNewMessage sendRequest userCommit = do   statsEnabled <- GHC.Stats.getGCStatsEnabled +  counterRef <- newIORef 0+  upstreamCounterRef <- newIORef Nothing+   _ <- Gtk.initGUI   _ <- Gtk.timeoutAddFull (CC.yield >> return True) Gtk.priorityDefault 50 @@ -37,15 +41,25 @@                    ]    statsLabel <- Gtk.labelNew (Nothing :: Maybe String)-  let statsWorker = do-        CC.threadDelay 500000-        msg <- if statsEnabled+  let makeStatsMessage = do+        statsMsg <- if statsEnabled                then do                  stats <- GHC.Stats.getGCStats                  return $ printf "The current memory usage is %.2f MB"                    ((realToFrac (GHC.Stats.currentBytesUsed stats) :: Double) /(1024*1024))                else return "(enable GHC statistics with +RTS -T)"-        Gtk.postGUISync $ Gtk.labelSetText statsLabel ("Welcome to set-ho-matic!\n" ++ msg)+        counter <- readIORef counterRef+        mupstreamCounter <- readIORef upstreamCounterRef+        let upstreamCount = case mupstreamCounter of+              Nothing -> "?"+              Just r -> show r+            counterMsg = "editing: " ++ show counter ++ " | upstream: " ++ upstreamCount+        return $ "Welcome to set-ho-matic!\n" ++ statsMsg ++ "\n" ++ counterMsg++      statsWorker = do+        CC.threadDelay 500000+        msg <- makeStatsMessage+        Gtk.postGUISync $ Gtk.labelSetText statsLabel msg         statsWorker    statsThread <- CC.forkIO statsWorker@@ -82,6 +96,14 @@                   ]  +  -- how to commit+  let commit val = do+        counter <- readIORef counterRef+        putStrLn $ "sending settings update " ++ show counter+        writeIORef counterRef (1 + counter)+        makeStatsMessage >>= Gtk.labelSetText statsLabel+        userCommit counter val+   -- the signal selector   (treeview, getLatestStaged, receiveNewUpstream, takeLatestUpstream, loadFromFile) <-     newLookupTreeview rootName initialValue (Gtk.toggleButtonGetActive buttonAutoCommit) commit@@ -132,11 +154,12 @@     , Gtk.boxChildPacking treeviewExpander := Gtk.PackGrow     ] -  _ <- on buttonCommit Gtk.buttonActivated $ do-    val <- getLatestStaged-    commit val+  _ <- on buttonCommit Gtk.buttonActivated $ (getLatestStaged >>= commit) -  _ <- on buttonRefresh Gtk.buttonActivated sendRequest+  _ <- on buttonRefresh Gtk.buttonActivated $ do+    counter <- readIORef counterRef+    putStrLn $ "sending settings request " ++ show counter+    sendRequest    _ <- on buttonTakeUpstream Gtk.buttonActivated takeLatestUpstream @@ -144,7 +167,11 @@         mmsg <- userPollForNewMessage         case mmsg of           Nothing -> return ()-          Just newVal -> receiveNewUpstream newVal+          Just (upstreamCounter, newVal) -> do+            putStrLn $ "received settings update " ++ show upstreamCounter+            writeIORef upstreamCounterRef (Just upstreamCounter)+            makeStatsMessage >>= Gtk.labelSetText statsLabel+            receiveNewUpstream newVal    _ <- Gtk.timeoutAddFull (pollForNewMessage >> return True) Gtk.priorityDefault 300