Split controller OSC off from SuperDirt handshake OSC (Redux for 1.9)

src/Sound/Tidal/Stream/Config.hs

@@ -1,5 +1,6 @@
 module Sound.Tidal.Stream.Config where
 
+import Control.Monad (when)
 import qualified Sound.Tidal.Clock as Clock
 
 {-
@@ -20,25 +21,31 @@ import qualified Sound.Tidal.Clock as Clock
     along with this library.  If not, see <http://www.gnu.org/licenses/>.
 -}
 
-data Config = Config {cCtrlListen :: Bool,
-                      cCtrlAddr :: String,
-                      cCtrlPort :: Int,
-                      cCtrlBroadcast :: Bool,
-                      -- cTempoAddr :: String,
-                      -- cTempoPort :: Int,
-                      -- cTempoClientPort :: Int,
-                      cVerbose :: Bool,
-                      cClockConfig :: Clock.ClockConfig
-                     }
+data Config = Config
+  { cCtrlListen :: Bool,
+    cCtrlAddr :: String,
+    cCtrlPort :: Int,
+    cCtrlBroadcast :: Bool,
+    -- cTempoAddr :: String,
+    -- cTempoPort :: Int,
+    -- cTempoClientPort :: Int,
+    cVerbose :: Bool,
+    cClockConfig :: Clock.ClockConfig
+  }
 
 defaultConfig :: Config
-defaultConfig = Config {cCtrlListen = True,
-                        cCtrlAddr ="127.0.0.1",
-                        cCtrlPort = 6010,
-                        cCtrlBroadcast = False,
-                        -- cTempoAddr = "127.0.0.1",
-                        -- cTempoPort = 9160,
-                        -- cTempoClientPort = 0, -- choose at random
-                        cVerbose = True,
-                        cClockConfig = Clock.defaultConfig
-                       }
+defaultConfig =
+  Config
+    { cCtrlListen = True,
+      cCtrlAddr = "127.0.0.1",
+      cCtrlPort = 6010,
+      cCtrlBroadcast = False,
+      -- cTempoAddr = "127.0.0.1",
+      -- cTempoPort = 9160,
+      -- cTempoClientPort = 0, -- choose at random
+      cVerbose = True,
+      cClockConfig = Clock.defaultConfig
+    }
+
+verbose :: Config -> String -> IO ()
+verbose c s = when (cVerbose c) $ putStrLn s

src/Sound/Tidal/Stream/Listen.hs

@@ -1,21 +1,18 @@
 module Sound.Tidal.Stream.Listen where
 
-import           Data.Maybe (fromJust, catMaybes, isJust)
-import           Control.Concurrent.MVar
-import           Control.Monad (when)
-import           System.IO (hPutStrLn, stderr)
+import Control.Concurrent.MVar
+import qualified Control.Exception as E
+import Control.Monad (when)
 import qualified Data.Map as Map
+import Data.Maybe (fromJust)
+import qualified Network.Socket as N
 import qualified Sound.Osc.Fd as O
-import qualified Sound.Osc.Time.Timeout as O
-import qualified Network.Socket         as N
-import qualified Control.Exception as E
-
-import           Sound.Tidal.ID
-import           Sound.Tidal.Pattern
-
-import           Sound.Tidal.Stream.Config
-import           Sound.Tidal.Stream.Types
-import           Sound.Tidal.Stream.UI
+import Sound.Tidal.ID
+import Sound.Tidal.Pattern
+import Sound.Tidal.Stream.Config
+import Sound.Tidal.Stream.Types
+import Sound.Tidal.Stream.UI
+import System.IO (hPutStrLn, stderr)
 
 {-
     Listen.hs - logic for listening and acting on incoming OSC messages
@@ -35,84 +32,69 @@ import           Sound.Tidal.Stream.UI
     along with this library.  If not, see <http://www.gnu.org/licenses/>.
 -}
 
-
 openListener :: Config -> IO (Maybe O.Udp)
 openListener c
-  | cCtrlListen c = catchAny run (\_ -> do verbose c "That port isn't available, perhaps another Tidal instance is already listening on that port?"
-                                           return Nothing
-                                 )
-  | otherwise  = return Nothing
+  | cCtrlListen c =
+      catchAny
+        run
+        ( \_ -> do
+            verbose c "That port isn't available, perhaps another Tidal instance is already listening on that port?"
+            return Nothing
+        )
+  | otherwise = return Nothing
   where
-        run = do sock <- O.udpServer (cCtrlAddr c) (cCtrlPort c)
-                 when (cCtrlBroadcast c) $ N.setSocketOption (O.udpSocket sock) N.Broadcast 1
-                 return $ Just sock
-        catchAny :: IO a -> (E.SomeException -> IO a) -> IO a
-        catchAny = E.catch
+    run = do
+      sock <- O.udpServer (cCtrlAddr c) (cCtrlPort c)
+      when (cCtrlBroadcast c) $ N.setSocketOption (O.udpSocket sock) N.Broadcast 1
+      return $ Just sock
+    catchAny :: IO a -> (E.SomeException -> IO a) -> IO a
+    catchAny = E.catch
 
 -- Listen to and act on OSC control messages
-ctrlResponder :: Int -> Config -> Stream -> IO ()
-ctrlResponder waits c (stream@(Stream {sListen = Just sock}))
-  = do ms <- recvMessagesTimeout 2 sock
-       if (null ms)
-         then do checkHandshake -- there was a timeout, check handshake
-                 ctrlResponder (waits+1) c stream
-         else do mapM_ act ms
-                 ctrlResponder 0 c stream
-     where
-        checkHandshake = do busses <- readMVar (sBusses stream)
-                            when (null busses) $ do when  (waits == 0) $ verbose c $ "Waiting for SuperDirt (v.1.7.2 or higher).."
-                                                    sendHandshakes stream
-
-        act (O.Message "/dirt/hello" _) = sendHandshakes stream
-        act (O.Message "/dirt/handshake/reply" xs) = do prev <- swapMVar (sBusses stream) $ bufferIndices xs
-                                                        -- Only report the first time..
-                                                        when (null prev) $ verbose c $ "Connected to SuperDirt."
-                                                        return ()
-          where
-            bufferIndices [] = []
-            bufferIndices (x:xs') | x == (O.AsciiString $ O.ascii "&controlBusIndices") = catMaybes $ takeWhile isJust $ map O.datum_integral xs'
-                                  | otherwise = bufferIndices xs'
-        -- External controller commands
-        act (O.Message "/ctrl" (O.Int32 k:v:[]))
-          = act (O.Message "/ctrl" [O.string $ show k,v])
-        act (O.Message "/ctrl" (O.AsciiString k:v@(O.Float _):[]))
-          = add (O.ascii_to_string k) (VF (fromJust $ O.datum_floating v))
-        act (O.Message "/ctrl" (O.AsciiString k:O.AsciiString v:[]))
-          = add (O.ascii_to_string k) (VS (O.ascii_to_string v))
-        act (O.Message "/ctrl" (O.AsciiString k:O.Int32 v:[]))
-          = add (O.ascii_to_string k) (VI (fromIntegral v))
-        -- Stream playback commands
-        act (O.Message "/mute" (k:[]))
-          = withID k $ streamMute stream
-        act (O.Message "/unmute" (k:[]))
-          = withID k $ streamUnmute stream
-        act (O.Message "/solo" (k:[]))
-          = withID k $ streamSolo stream
-        act (O.Message "/unsolo" (k:[]))
-          = withID k $ streamUnsolo stream
-        act (O.Message "/muteAll" [])
-          = streamMuteAll stream
-        act (O.Message "/unmuteAll" [])
-          = streamUnmuteAll stream
-        act (O.Message "/unsoloAll" [])
-          = streamUnsoloAll stream
-        act (O.Message "/hush" [])
-          = streamHush stream
-        act (O.Message "/silence" (k:[]))
-          = withID k $ streamSilence stream
-        act m = hPutStrLn stderr $ "Unhandled OSC: " ++ show m
-        add :: String -> Value -> IO ()
-        add k v = do sMap <- takeMVar (sStateMV stream)
-                     putMVar (sStateMV stream) $ Map.insert k v sMap
-                     return ()
-        withID :: O.Datum -> (ID -> IO ()) -> IO ()
-        withID (O.AsciiString k) func = func $ (ID . O.ascii_to_string) k
-        withID (O.Int32 k) func = func $ (ID . show) k
-        withID _ _ = return ()
-ctrlResponder _ _ _ = return ()
-
-verbose :: Config -> String -> IO ()
-verbose c s = when (cVerbose c) $ putStrLn s
-
-recvMessagesTimeout :: (O.Transport t) => Double -> t -> IO [O.Message]
-recvMessagesTimeout n sock = fmap (maybe [] O.packetMessages) $ O.recvPacketTimeout n sock
+ctrlResponder :: Config -> Stream -> IO ()
+ctrlResponder _ (stream@(Stream {sListen = Just sock})) = loop
+  where
+    loop :: IO ()
+    loop = do
+      O.recvMessages sock >>= mapM_ act
+      loop
+    -- External controller commands
+    act :: O.Message -> IO ()
+    act (O.Message "/ctrl" (O.Int32 k : v : [])) =
+      act (O.Message "/ctrl" [O.string $ show k, v])
+    act (O.Message "/ctrl" (O.AsciiString k : v@(O.Float _) : [])) =
+      add (O.ascii_to_string k) (VF (fromJust $ O.datum_floating v))
+    act (O.Message "/ctrl" (O.AsciiString k : O.AsciiString v : [])) =
+      add (O.ascii_to_string k) (VS (O.ascii_to_string v))
+    act (O.Message "/ctrl" (O.AsciiString k : O.Int32 v : [])) =
+      add (O.ascii_to_string k) (VI (fromIntegral v))
+    -- Stream playback commands
+    act (O.Message "/mute" (k : [])) =
+      withID k $ streamMute stream
+    act (O.Message "/unmute" (k : [])) =
+      withID k $ streamUnmute stream
+    act (O.Message "/solo" (k : [])) =
+      withID k $ streamSolo stream
+    act (O.Message "/unsolo" (k : [])) =
+      withID k $ streamUnsolo stream
+    act (O.Message "/muteAll" []) =
+      streamMuteAll stream
+    act (O.Message "/unmuteAll" []) =
+      streamUnmuteAll stream
+    act (O.Message "/unsoloAll" []) =
+      streamUnsoloAll stream
+    act (O.Message "/hush" []) =
+      streamHush stream
+    act (O.Message "/silence" (k : [])) =
+      withID k $ streamSilence stream
+    act m = hPutStrLn stderr $ "Unhandled OSC: " ++ show m
+    add :: String -> Value -> IO ()
+    add k v = do
+      sMap <- takeMVar (sStateMV stream)
+      putMVar (sStateMV stream) $ Map.insert k v sMap
+      return ()
+    withID :: O.Datum -> (ID -> IO ()) -> IO ()
+    withID (O.AsciiString k) func = func $ (ID . O.ascii_to_string) k
+    withID (O.Int32 k) func = func $ (ID . show) k
+    withID _ _ = return ()
+ctrlResponder _ _ = return ()

src/Sound/Tidal/Stream/Main.hs

@@ -1,19 +1,16 @@
 module Sound.Tidal.Stream.Main where
 
+import Control.Concurrent
+import Control.Concurrent.MVar
 import qualified Data.Map as Map
 import qualified Sound.Tidal.Clock as Clock
-import           Control.Concurrent.MVar
-import           Control.Concurrent
-import           System.IO (hPutStrLn, stderr)
-
-
-import           Sound.Tidal.Version (tidal_status_string)
-import           Sound.Tidal.Stream.Config
-import           Sound.Tidal.Stream.Types
-import           Sound.Tidal.Stream.Listen
-import           Sound.Tidal.Stream.Target
-import           Sound.Tidal.Stream.Process
-import           Sound.Tidal.Stream.UI
+import Sound.Tidal.Stream.Config
+import Sound.Tidal.Stream.Listen
+import Sound.Tidal.Stream.Process
+import Sound.Tidal.Stream.Target
+import Sound.Tidal.Stream.Types
+import Sound.Tidal.Version (tidal_status_string)
+import System.IO (hPutStrLn, stderr)
 
 {-
     Main.hs - Start tidals stream, listen and act on incoming messages
@@ -33,7 +30,6 @@ import           Sound.Tidal.Stream.UI
     along with this library.  If not, see <http://www.gnu.org/licenses/>.
 -}
 
-
 -- Start an instance of Tidal with superdirt OSC
 startTidal :: Target -> Config -> IO Stream
 startTidal target config = startStream config [(target, [superdirtShape])]
@@ -43,36 +39,34 @@ startTidal target config = startStream config [(target, [superdirtShape])]
 -- Spawns a thread that listens to and acts on OSC control messages
 startStream :: Config -> [(Target, [OSC])] -> IO Stream
 startStream config oscmap = do
-       sMapMV <- newMVar Map.empty
-       pMapMV <- newMVar Map.empty
-       bussesMV <- newMVar []
-       globalFMV <- newMVar id
-
-       tidal_status_string >>= verbose config
-       verbose config $ "Listening for external controls on " ++ cCtrlAddr config ++ ":" ++ show (cCtrlPort config)
-       listen <- openListener config
-
-       cxs <- getCXs config oscmap
-
-       clockRef <- Clock.clocked (cClockConfig config) (doTick sMapMV bussesMV pMapMV globalFMV cxs listen)
-
-       let stream = Stream {sConfig = config,
-                            sBusses = bussesMV,
-                            sStateMV  = sMapMV,
-                            sClockRef = clockRef,
-                            -- sLink = abletonLink,
-                            sListen = listen,
-                            sPMapMV = pMapMV,
-                            -- sActionsMV = actionsMV,
-                            sGlobalFMV = globalFMV,
-                            sCxs = cxs
-                           }
-
-       sendHandshakes stream
-
-       -- Spawn a thread to handle OSC control messages
-       _ <- forkIO $ ctrlResponder 0 config stream
-       return stream
+  sMapMV <- newMVar Map.empty
+  pMapMV <- newMVar Map.empty
+  globalFMV <- newMVar id
+
+  tidal_status_string >>= verbose config
+  verbose config $ "Listening for external controls on " ++ cCtrlAddr config ++ ":" ++ show (cCtrlPort config)
+  listen <- openListener config
+
+  cxs <- getCXs config oscmap
+
+  clockRef <- Clock.clocked (cClockConfig config) (doTick sMapMV pMapMV globalFMV cxs)
+
+  let stream =
+        Stream
+          { sConfig = config,
+            sStateMV = sMapMV,
+            sClockRef = clockRef,
+            -- sLink = abletonLink,
+            sListen = listen,
+            sPMapMV = pMapMV,
+            -- sActionsMV = actionsMV,
+            sGlobalFMV = globalFMV,
+            sCxs = cxs
+          }
+
+  -- Spawn a thread to handle OSC control messages
+  _ <- forkIO $ ctrlResponder config stream
+  return stream
 
 startMulti :: [Target] -> Config -> IO ()
 startMulti _ _ = hPutStrLn stderr $ "startMulti has been removed, please check the latest documentation on tidalcycles.org"