From f4a7309bacc1c310287e1737a673b32168e458e9 Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Sun, 25 Apr 2021 12:37:48 +0200 Subject: [PATCH 1/4] XXX: envrc and nix files --- .envrc | 1 + default.nix | 5 +++++ shell.nix | 1 + 3 files changed, 7 insertions(+) create mode 100644 .envrc create mode 100644 default.nix create mode 100644 shell.nix diff --git a/.envrc b/.envrc new file mode 100644 index 0000000..1d953f4 --- /dev/null +++ b/.envrc @@ -0,0 +1 @@ +use nix diff --git a/default.nix b/default.nix new file mode 100644 index 0000000..0eb5c94 --- /dev/null +++ b/default.nix @@ -0,0 +1,5 @@ +{ pkgs ? import {} }: +let + src = pkgs.nix-gitignore.gitignoreSource [ ] ./.; +in + pkgs.haskellPackages.callCabal2nix "tidal-listener" src { } diff --git a/shell.nix b/shell.nix new file mode 100644 index 0000000..e860245 --- /dev/null +++ b/shell.nix @@ -0,0 +1 @@ +(import ./default.nix {}).env From c74fed08c9b5632d36a6af818ecc8865359fb831 Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Sun, 2 May 2021 10:36:16 +0200 Subject: [PATCH 2/4] cabal: category Sound --- tidal-listener.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tidal-listener.cabal b/tidal-listener.cabal index 00716ad..860cd9c 100644 --- a/tidal-listener.cabal +++ b/tidal-listener.cabal @@ -10,7 +10,7 @@ license-file: LICENSE author: Lizzie Wilson and Alex McLean maintainer: alex@slab.org -- copyright: --- category: +category: Sound build-type: Simple extra-source-files: CHANGELOG.md, README.md From 48254a417294052aace8c0808225a1dd99988dda Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Sat, 17 Jul 2021 12:37:42 +0200 Subject: [PATCH 3/4] add ListenerConfig and listenWithConfig --- src/Sound/Tidal/Listener.hs | 15 +++++++++++---- src/Sound/Tidal/Listener/Config.hs | 17 +++++++++++++++++ tidal-listener.cabal | 2 ++ 3 files changed, 30 insertions(+), 4 deletions(-) create mode 100644 src/Sound/Tidal/Listener/Config.hs diff --git a/src/Sound/Tidal/Listener.hs b/src/Sound/Tidal/Listener.hs index b514714..bbef8d3 100644 --- a/src/Sound/Tidal/Listener.hs +++ b/src/Sound/Tidal/Listener.hs @@ -1,8 +1,12 @@ +{-# LANGUAGE RecordWildCards #-} module Sound.Tidal.Listener where +import Data.Default (def) + import Sound.Tidal.Stream (Target(..)) import qualified Sound.Tidal.Context as T import Sound.Tidal.Hint +import Sound.Tidal.Listener.Config import Sound.OSC.FD as O import Control.Concurrent import Control.Concurrent.MVar @@ -20,12 +24,15 @@ data State = State {sIn :: MVar String, sStream :: T.Stream } -listenPort = 6011 -remotePort = 6012 +-- | Start Haskell interpreter, with input and output mutable variables to +-- communicate with it listen :: IO () -listen = do -- start Haskell interpreter, with input and output mutable variables to - -- communicate with it +listen = listenWithConfig def + +-- | Configurable variant of @listen@ +listenWithConfig :: ListenerConfig -> IO () +listenWithConfig ListenerConfig{..} = do (mIn, mOut) <- startHint -- listen (remote_addr:_) <- N.getAddrInfo Nothing (Just "127.0.0.1") Nothing diff --git a/src/Sound/Tidal/Listener/Config.hs b/src/Sound/Tidal/Listener/Config.hs new file mode 100644 index 0000000..f4a84c5 --- /dev/null +++ b/src/Sound/Tidal/Listener/Config.hs @@ -0,0 +1,17 @@ + +module Sound.Tidal.Listener.Config where + +import Data.Default + +data ListenerConfig = ListenerConfig { + listenPort :: Int -- ^ UDP port for tidal-listener + , remotePort :: Int -- ^ UDP port for tidal + , doDeltaMini:: Bool -- ^ Apply @deltaMini@ to patterns + } deriving (Eq, Show) + +instance Default ListenerConfig where + def = ListenerConfig { + listenPort = 6011 + , remotePort = 6012 + , doDeltaMini = True + } diff --git a/tidal-listener.cabal b/tidal-listener.cabal index 860cd9c..87a00de 100644 --- a/tidal-listener.cabal +++ b/tidal-listener.cabal @@ -17,8 +17,10 @@ extra-source-files: CHANGELOG.md, README.md library hs-source-dirs: src exposed-modules: Sound.Tidal.Listener + Sound.Tidal.Listener.Config Sound.Tidal.Hint build-depends: base >= 4.7 && < 5, + data-default, tidal >=1.7.1, hosc, unix, From a76cb761a89537b464c3eae582e24ce5322f8484 Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Sat, 17 Jul 2021 12:43:09 +0200 Subject: [PATCH 4/4] WIP: Sound.Tidal.Protocol --- src/Sound/Tidal/Protocol.hs | 138 ++++++++++++++++++++++++++++++++++++ 1 file changed, 138 insertions(+) create mode 100644 src/Sound/Tidal/Protocol.hs diff --git a/src/Sound/Tidal/Protocol.hs b/src/Sound/Tidal/Protocol.hs new file mode 100644 index 0000000..7f4b945 --- /dev/null +++ b/src/Sound/Tidal/Protocol.hs @@ -0,0 +1,138 @@ +-- {-# LANGUAGE DataKinds #-} +-- {-# LANGUAGE GADTs #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Listener protocol + +module Sound.Tidal.Protocol where + +import Sound.OSC.FD -- (UDP, sendMessage) +import Control.Concurrent +import Control.Concurrent.Async +import Control.Concurrent.STM +import Control.Exception +import Control.Monad +import Control.Monad.Trans.Reader (ReaderT, ask, runReaderT) +import Control.Monad.IO.Class (liftIO) + +data ClientContext = ClientContext { + ccTarget :: UDP + , ccServer :: UDP + } + +type ClientMonad = ReaderT ClientContext IO + +initContext :: IO ClientContext +initContext = do + ccTarget <- openUDP "127.0.0.1" 6011 + ccServer <- udpServer "127.0.0.1" 6012 + pure ClientContext{..} + +ping :: ClientMonad () +ping = do + send $ message "/ping" mempty + void $ waitMessageOnAddr "/pong" + +codeMsg streamName codeStr = message "/code" [string streamName, string codeStr] + +code streamName codeStr = send $ codeMsg streamName codeStr + +getCps :: ClientMonad () +getCps = do + send $ message "/cps" mempty + +send msg = do + t <- ccTarget <$> ask + liftIO $ sendMessage t msg + +receive = do + s <- ccServer <$> ask + mMsg <- liftIO $ recvMessage s + case mMsg of + Nothing -> error "recvMessage returns Nothing.. should't happen?" + Just msg -> pure msg + +waitMessageOnAddr addr = do + msg <- receive + if messageAddress msg == addr + then return msg + else waitMessageOnAddr addr + +runClient act = do + bracket + initContext + (\ClientContext{..} -> do + udp_close ccTarget + udp_close ccServer) + (runReaderT act) + +delay sec = liftIO $ threadDelay (1000000 * sec) + +demo = do + code "hello" "sound \"bd bass\"" + code "secondStream" "sound \"~ ht*2\"" + delay 55 + code "hello" "stack [ \n sound \"v*4\" \n , sound \"arpy(3,5)\" ]" + delay 5 + code "hello" "silence" + code "secondStream" "silence" + +data ServerResponse = + CodeOk String + | CodeErr String String + | CPS Float + | Highlight { + hDelta :: Float + , hCycle :: Float + , hX0 :: Int + , hY0 :: Int + , hX1 :: Int + , hY1 :: Int + } + +toResponse (Message "/code/ok" [ASCII_String a_ident]) = CodeOk (ascii_to_string a_ident) +toResponse (Message "/code/error" [ASCII_String a_ident, ASCII_String err]) = CodeErr (ascii_to_string a_ident) (ascii_to_string err) +--toResponse (Message "/code/highlight" +-- [ASCII_String a_ident, ASCII_String err]) = CodeErr (ascii_to_string a_ident) (ascii_to_string err) + +justdoit = do + q <- newTChanIO + stream q + +stream srvQ = runClient $ do + ping + s <- ccServer <$> ask + liftIO $ async $ forever $ do + msg <- recvMessage' s + atomically $ writeTChan srvQ msg + + liftIO $ async $ forever $ do + fq <- atomically $ readTChan srvQ + print fq + + demo + +tidalClient :: TChan Message -> TChan Message -> IO () +tidalClient toTidal fromTidal = runClient $ do + ping + s <- ccServer <$> ask + void $ liftIO $ async $ forever $ do + msg <- recvMessage' s + atomically $ writeTChan fromTidal msg + + t <- ccTarget <$> ask + liftIO $ forever $ do + msg <- atomically $ readTChan toTidal + sendMessage t msg + +-- utils + +recvMessage' s = do + mMsg <- recvMessage s + case mMsg of + Nothing -> error "recvMessage returns Nothing.. should't happen?" + Just msg -> pure msg + + +sendCode r x = sendMessage r $ Message "/code" [string "tmp", string x]