Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

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

Open
wants to merge 10 commits into
base: dev
Choose a base branch
from
Prev Previous commit
Next Next commit
Apply stylish-haskell to Stream modules
  • Loading branch information
mindofmatthew committed Apr 19, 2024
commit 7d3a08e6cb4a73bbf2046649c5e75d6e42d550d4
14 changes: 7 additions & 7 deletions src/Sound/Tidal/Stream/Config.hs
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
module Sound.Tidal.Stream.Config where

import Control.Monad (when)
import Control.Monad (when)

import qualified Sound.Tidal.Clock as Clock

Expand All @@ -22,15 +22,15 @@ 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,
data Config = Config {cCtrlListen :: Bool,
cCtrlAddr :: String,
cCtrlPort :: Int,
cCtrlBroadcast :: Bool,
-- cTempoAddr :: String,
-- cTempoPort :: Int,
-- cTempoClientPort :: Int,
cVerbose :: Bool,
cClockConfig :: Clock.ClockConfig
cVerbose :: Bool,
cClockConfig :: Clock.ClockConfig
}

defaultConfig :: Config
Expand All @@ -46,4 +46,4 @@ defaultConfig = Config {cCtrlListen = True,
}

verbose :: Config -> String -> IO ()
verbose c s = when (cVerbose c) $ putStrLn s
verbose c s = when (cVerbose c) $ putStrLn s
18 changes: 9 additions & 9 deletions src/Sound/Tidal/Stream/Listen.hs
Original file line number Diff line number Diff line change
@@ -1,13 +1,13 @@
module Sound.Tidal.Stream.Listen where

import Data.Maybe (fromJust)
import Control.Concurrent.MVar
import Control.Monad (when)
import System.IO (hPutStrLn, stderr)
import qualified Data.Map as Map
import qualified Sound.Osc.Fd as O
import qualified Network.Socket as N
import qualified Control.Exception as E
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 System.IO (hPutStrLn, stderr)

import Sound.Tidal.ID
import Sound.Tidal.Pattern
Expand Down Expand Up @@ -91,6 +91,6 @@ ctrlResponder _ (stream@(Stream {sListen = Just sock})) = loop
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 ()
withID (O.Int32 k) func = func $ (ID . show) k
withID _ _ = return ()
ctrlResponder _ _ = return ()
14 changes: 7 additions & 7 deletions src/Sound/Tidal/Stream/Main.hs
Original file line number Diff line number Diff line change
@@ -1,18 +1,18 @@
module Sound.Tidal.Stream.Main where

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 Control.Concurrent.MVar
import qualified Data.Map as Map
import qualified Sound.Tidal.Clock as Clock
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.Target
import Sound.Tidal.Stream.Types
import Sound.Tidal.Version (tidal_status_string)

{-
Main.hs - Start tidals stream, listen and act on incoming messages
Expand Down
99 changes: 52 additions & 47 deletions src/Sound/Tidal/Stream/Process.hs
Original file line number Diff line number Diff line change
@@ -1,6 +1,11 @@
{-# LANGUAGE ConstraintKinds, GeneralizedNewtypeDeriving, FlexibleContexts, ScopedTypeVariables, BangPatterns #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-missing-fields #-}
{-# language DeriveGeneric, StandaloneDeriving #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StandaloneDeriving #-}

module Sound.Tidal.Stream.Process where

Expand All @@ -22,43 +27,43 @@ module Sound.Tidal.Stream.Process where
along with this library. If not, see <http://www.gnu.org/licenses/>.
-}

import Control.Applicative ((<|>))
import Control.Applicative ((<|>))
import Control.Concurrent.MVar
import Control.Monad (forM_, when)
import Data.Coerce (coerce)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromJust, fromMaybe, catMaybes)
import qualified Control.Exception as E
import qualified Control.Exception as E
import Control.Monad (forM_, when)
import Data.Coerce (coerce)
import qualified Data.Map.Strict as Map
import Data.Maybe (catMaybes, fromJust, fromMaybe)
import Foreign.C.Types
import System.IO (hPutStrLn, stderr)
import System.IO (hPutStrLn, stderr)

import qualified Sound.Osc.Fd as O
import qualified Sound.Osc.Fd as O

import Sound.Tidal.Stream.Config
import Sound.Tidal.Core (stack, (#))
import Data.List (sortOn)
import qualified Sound.Tidal.Clock as Clock
import Sound.Tidal.Core (stack, (#))
import Sound.Tidal.ID
import qualified Sound.Tidal.Link as Link
import qualified Sound.Tidal.Clock as Clock
import Sound.Tidal.Params (pS)
import qualified Sound.Tidal.Link as Link
import Sound.Tidal.Params (pS)
import Sound.Tidal.Pattern
import Sound.Tidal.Utils ((!!!))
import Data.List (sortOn)
import Sound.Tidal.Show ()
import Sound.Tidal.Show ()
import Sound.Tidal.Stream.Config
import Sound.Tidal.Utils ((!!!))

import Sound.Tidal.Stream.Types
import Sound.Tidal.Stream.Target
import Sound.Tidal.Stream.Types

data ProcessedEvent =
ProcessedEvent {
peHasOnset :: Bool,
peEvent :: Event ValueMap,
peCps :: Link.BPM,
peDelta :: Link.Micros,
peCycle :: Time,
peOnWholeOrPart :: Link.Micros,
peHasOnset :: Bool,
peEvent :: Event ValueMap,
peCps :: Link.BPM,
peDelta :: Link.Micros,
peCycle :: Time,
peOnWholeOrPart :: Link.Micros,
peOnWholeOrPartOsc :: O.Time,
peOnPart :: Link.Micros,
peOnPartOsc :: O.Time
peOnPart :: Link.Micros,
peOnPartOsc :: O.Time
}

-- | Query the current pattern (contained in argument @stream :: Stream@)
Expand Down Expand Up @@ -107,7 +112,7 @@ doTick stateMV playMV globalFMV cxs (st,end) nudge ops =
tes <- processCps ops es'
-- For each OSC target
forM_ cxs $ \cx@(Cx target _ oscs _ _ bussesMV) -> do
busses <- mapM readMVar bussesMV
busses <- mapM readMVar bussesMV
-- Latency is configurable per target.
-- Latency is only used when sending events live.
let latency = oLatency target
Expand Down Expand Up @@ -225,15 +230,15 @@ toData (OSC {args = Named rqrd}) e
toData _ _ = Nothing

toDatum :: Value -> O.Datum
toDatum (VF x) = O.float x
toDatum (VN x) = O.float x
toDatum (VI x) = O.int32 x
toDatum (VS x) = O.string x
toDatum (VR x) = O.float $ ((fromRational x) :: Double)
toDatum (VB True) = O.int32 (1 :: Int)
toDatum (VF x) = O.float x
toDatum (VN x) = O.float x
toDatum (VI x) = O.int32 x
toDatum (VS x) = O.string x
toDatum (VR x) = O.float $ ((fromRational x) :: Double)
toDatum (VB True) = O.int32 (1 :: Int)
toDatum (VB False) = O.int32 (0 :: Int)
toDatum (VX xs) = O.Blob $ O.blob_pack xs
toDatum _ = error "toDatum: unhandled value"
toDatum (VX xs) = O.Blob $ O.blob_pack xs
toDatum _ = error "toDatum: unhandled value"

substitutePath :: String -> ValueMap -> Maybe String
substitutePath str cm = parse str
Expand All @@ -251,19 +256,19 @@ getString :: ValueMap -> String -> Maybe String
getString cm s = (simpleShow <$> Map.lookup param cm) <|> defaultValue dflt
where (param, dflt) = break (== '=') s
simpleShow :: Value -> String
simpleShow (VS str) = str
simpleShow (VI i) = show i
simpleShow (VF f) = show f
simpleShow (VN n) = show n
simpleShow (VR r) = show r
simpleShow (VB b) = show b
simpleShow (VX xs) = show xs
simpleShow (VState _) = show "<stateful>"
simpleShow (VS str) = str
simpleShow (VI i) = show i
simpleShow (VF f) = show f
simpleShow (VN n) = show n
simpleShow (VR r) = show r
simpleShow (VB b) = show b
simpleShow (VX xs) = show xs
simpleShow (VState _) = show "<stateful>"
simpleShow (VPattern _) = show "<pattern>"
simpleShow (VList _) = show "<list>"
simpleShow (VList _) = show "<list>"
defaultValue :: String -> Maybe String
defaultValue ('=':dfltVal) = Just dfltVal
defaultValue _ = Nothing
defaultValue _ = Nothing

playStack :: PlayMap -> ControlPattern
playStack pMap = stack . (map pattern) . (filter active) . Map.elems $ pMap
Expand Down Expand Up @@ -313,5 +318,5 @@ setPreviousPatternOrSilence playMV =
modifyMVar_ playMV $ return
. Map.map ( \ pMap -> case history pMap of
_:p:ps -> pMap { pattern = p, history = p:ps }
_ -> pMap { pattern = silence, history = [silence] }
_ -> pMap { pattern = silence, history = [silence] }
)
17 changes: 9 additions & 8 deletions src/Sound/Tidal/Stream/Target.hs
Original file line number Diff line number Diff line change
@@ -1,16 +1,17 @@
module Sound.Tidal.Stream.Target where

import qualified Sound.Osc.Fd as O
import qualified Sound.Osc.Time.Timeout as O
import qualified Network.Socket as N
import Data.Maybe (fromJust, isJust, catMaybes)
import Control.Concurrent (newMVar, readMVar, swapMVar, forkIO, forkOS, threadDelay)
import Control.Monad (when)
import Foreign (Word8)
import Control.Concurrent (forkIO, forkOS, newMVar, readMVar,
swapMVar, threadDelay)
import Control.Monad (when)
import Data.Maybe (catMaybes, fromJust, isJust)
import Foreign (Word8)
import qualified Network.Socket as N
import qualified Sound.Osc.Fd as O
import qualified Sound.Osc.Time.Timeout as O

import Sound.Tidal.Pattern
import Sound.Tidal.Stream.Types
import Sound.Tidal.Stream.Config
import Sound.Tidal.Stream.Types

{-
Target.hs - Create and send to OSC targets
Expand Down
54 changes: 27 additions & 27 deletions src/Sound/Tidal/Stream/Types.hs
Original file line number Diff line number Diff line change
@@ -1,33 +1,33 @@
module Sound.Tidal.Stream.Types where

import Control.Concurrent.MVar
import qualified Data.Map.Strict as Map
import Sound.Tidal.Pattern
import Sound.Tidal.Show ()
import qualified Data.Map.Strict as Map
import Sound.Tidal.Pattern
import Sound.Tidal.Show ()

import qualified Sound.Osc.Fd as O
import qualified Network.Socket as N
import qualified Network.Socket as N
import qualified Sound.Osc.Fd as O

import qualified Sound.Tidal.Clock as Clock
import qualified Sound.Tidal.Clock as Clock

import Sound.Tidal.Stream.Config
import Sound.Tidal.Stream.Config

data Stream = Stream {sConfig :: Config,
sStateMV :: MVar ValueMap,
data Stream = Stream {sConfig :: Config,
sStateMV :: MVar ValueMap,
-- sOutput :: MVar ControlPattern,
sClockRef :: Clock.ClockRef,
sListen :: Maybe O.Udp,
sPMapMV :: MVar PlayMap,
sClockRef :: Clock.ClockRef,
sListen :: Maybe O.Udp,
sPMapMV :: MVar PlayMap,
sGlobalFMV :: MVar (ControlPattern -> ControlPattern),
sCxs :: [Cx]
sCxs :: [Cx]
}

data Cx = Cx {cxTarget :: Target,
cxUDP :: O.Udp,
cxOSCs :: [OSC],
cxAddr :: N.AddrInfo,
data Cx = Cx {cxTarget :: Target,
cxUDP :: O.Udp,
cxOSCs :: [OSC],
cxAddr :: N.AddrInfo,
cxBusAddr :: Maybe N.AddrInfo,
cxBusses :: Maybe (MVar [Int])
cxBusses :: Maybe (MVar [Int])
}

data StampStyle = BundleStamp
Expand All @@ -38,13 +38,13 @@ data Schedule = Pre StampStyle
| Live
deriving (Eq, Show)

data Target = Target {oName :: String,
oAddress :: String,
oPort :: Int,
oBusPort :: Maybe Int,
oLatency :: Double,
oWindow :: Maybe Arc,
oSchedule :: Schedule,
data Target = Target {oName :: String,
oAddress :: String,
oPort :: Int,
oBusPort :: Maybe Int,
oLatency :: Double,
oWindow :: Maybe Arc,
oSchedule :: Schedule,
oHandshake :: Bool
}
deriving Show
Expand All @@ -60,8 +60,8 @@ data OSC = OSC {path :: String,
deriving Show

data PlayState = PlayState {pattern :: ControlPattern,
mute :: Bool,
solo :: Bool,
mute :: Bool,
solo :: Bool,
history :: [ControlPattern]
}
deriving Show
Expand Down
Loading