{-# LANGUAGE ConstraintKinds, GeneralizedNewtypeDeriving, FlexibleContexts, ScopedTypeVariables, BangPatterns #-}
{-# OPTIONS_GHC -fno-warn-missing-fields #-}
module Sound.Tidal.Stream where
import Control.Applicative ((<|>))
import Control.Concurrent.MVar
import Control.Concurrent
import qualified Data.Map.Strict as Map
import Data.Maybe (fromJust, fromMaybe, catMaybes)
import qualified Control.Exception as E
import System.IO (hPutStrLn, stderr)
import qualified Sound.OSC.FD as O
import Sound.Tidal.Config
import Sound.Tidal.Core (stack, silence)
import Sound.Tidal.Pattern
import qualified Sound.Tidal.Tempo as T
import Data.List (sortOn)
import System.Random (getStdRandom, randomR)
import Sound.Tidal.Show ()
data Stream = Stream {Stream -> Config
sConfig :: Config,
Stream -> MVar StateMap
sInput :: MVar StateMap,
Stream -> Maybe ThreadId
sListenTid :: Maybe ThreadId,
Stream -> MVar PlayMap
sPMapMV :: MVar PlayMap,
Stream -> MVar Tempo
sTempoMV :: MVar T.Tempo,
Stream -> MVar (ControlPattern -> ControlPattern)
sGlobalFMV :: MVar (ControlPattern -> ControlPattern),
Stream -> [Cx]
sCxs :: [Cx]
}
type PatId = String
data Cx = Cx {Cx -> Target
cxTarget :: Target,
Cx -> UDP
cxUDP :: O.UDP,
Cx -> [OSC]
cxOSCs :: [OSC]
}
deriving (Int -> Cx -> ShowS
[Cx] -> ShowS
Cx -> String
(Int -> Cx -> ShowS)
-> (Cx -> String) -> ([Cx] -> ShowS) -> Show Cx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cx] -> ShowS
$cshowList :: [Cx] -> ShowS
show :: Cx -> String
$cshow :: Cx -> String
showsPrec :: Int -> Cx -> ShowS
$cshowsPrec :: Int -> Cx -> ShowS
Show)
data StampStyle = BundleStamp
| MessageStamp
deriving (StampStyle -> StampStyle -> Bool
(StampStyle -> StampStyle -> Bool)
-> (StampStyle -> StampStyle -> Bool) -> Eq StampStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StampStyle -> StampStyle -> Bool
$c/= :: StampStyle -> StampStyle -> Bool
== :: StampStyle -> StampStyle -> Bool
$c== :: StampStyle -> StampStyle -> Bool
Eq, Int -> StampStyle -> ShowS
[StampStyle] -> ShowS
StampStyle -> String
(Int -> StampStyle -> ShowS)
-> (StampStyle -> String)
-> ([StampStyle] -> ShowS)
-> Show StampStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StampStyle] -> ShowS
$cshowList :: [StampStyle] -> ShowS
show :: StampStyle -> String
$cshow :: StampStyle -> String
showsPrec :: Int -> StampStyle -> ShowS
$cshowsPrec :: Int -> StampStyle -> ShowS
Show)
data Schedule = Pre StampStyle
| Live
deriving (Schedule -> Schedule -> Bool
(Schedule -> Schedule -> Bool)
-> (Schedule -> Schedule -> Bool) -> Eq Schedule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Schedule -> Schedule -> Bool
$c/= :: Schedule -> Schedule -> Bool
== :: Schedule -> Schedule -> Bool
$c== :: Schedule -> Schedule -> Bool
Eq, Int -> Schedule -> ShowS
[Schedule] -> ShowS
Schedule -> String
(Int -> Schedule -> ShowS)
-> (Schedule -> String) -> ([Schedule] -> ShowS) -> Show Schedule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Schedule] -> ShowS
$cshowList :: [Schedule] -> ShowS
show :: Schedule -> String
$cshow :: Schedule -> String
showsPrec :: Int -> Schedule -> ShowS
$cshowsPrec :: Int -> Schedule -> ShowS
Show)
data Target = Target {Target -> String
oName :: String,
Target -> String
oAddress :: String,
Target -> Int
oPort :: Int,
Target -> Double
oLatency :: Double,
Target -> Maybe Arc
oWindow :: Maybe Arc,
Target -> Schedule
oSchedule :: Schedule
}
deriving Int -> Target -> ShowS
[Target] -> ShowS
Target -> String
(Int -> Target -> ShowS)
-> (Target -> String) -> ([Target] -> ShowS) -> Show Target
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Target] -> ShowS
$cshowList :: [Target] -> ShowS
show :: Target -> String
$cshow :: Target -> String
showsPrec :: Int -> Target -> ShowS
$cshowsPrec :: Int -> Target -> ShowS
Show
data Args = Named {Args -> [String]
required :: [String]}
| ArgList [(String, Maybe Value)]
deriving Int -> Args -> ShowS
[Args] -> ShowS
Args -> String
(Int -> Args -> ShowS)
-> (Args -> String) -> ([Args] -> ShowS) -> Show Args
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Args] -> ShowS
$cshowList :: [Args] -> ShowS
show :: Args -> String
$cshow :: Args -> String
showsPrec :: Int -> Args -> ShowS
$cshowsPrec :: Int -> Args -> ShowS
Show
data OSC = OSC {OSC -> String
path :: String,
OSC -> Args
args :: Args
}
deriving Int -> OSC -> ShowS
[OSC] -> ShowS
OSC -> String
(Int -> OSC -> ShowS)
-> (OSC -> String) -> ([OSC] -> ShowS) -> Show OSC
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OSC] -> ShowS
$cshowList :: [OSC] -> ShowS
show :: OSC -> String
$cshow :: OSC -> String
showsPrec :: Int -> OSC -> ShowS
$cshowsPrec :: Int -> OSC -> ShowS
Show
data PlayState = PlayState {PlayState -> ControlPattern
pattern :: ControlPattern,
PlayState -> Bool
mute :: Bool,
PlayState -> Bool
solo :: Bool,
PlayState -> [ControlPattern]
history :: [ControlPattern]
}
deriving Int -> PlayState -> ShowS
[PlayState] -> ShowS
PlayState -> String
(Int -> PlayState -> ShowS)
-> (PlayState -> String)
-> ([PlayState] -> ShowS)
-> Show PlayState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlayState] -> ShowS
$cshowList :: [PlayState] -> ShowS
show :: PlayState -> String
$cshow :: PlayState -> String
showsPrec :: Int -> PlayState -> ShowS
$cshowsPrec :: Int -> PlayState -> ShowS
Show
type PlayMap = Map.Map PatId PlayState
superdirtTarget :: Target
superdirtTarget :: Target
superdirtTarget = Target :: String
-> String -> Int -> Double -> Maybe Arc -> Schedule -> Target
Target {oName :: String
oName = "SuperDirt",
oAddress :: String
oAddress = "127.0.0.1",
oPort :: Int
oPort = 57120,
oLatency :: Double
oLatency = 0.2,
oWindow :: Maybe Arc
oWindow = Maybe Arc
forall a. Maybe a
Nothing,
oSchedule :: Schedule
oSchedule = StampStyle -> Schedule
Pre StampStyle
BundleStamp
}
superdirtShape :: OSC
superdirtShape :: OSC
superdirtShape = String -> Args -> OSC
OSC "/play2" (Args -> OSC) -> Args -> OSC
forall a b. (a -> b) -> a -> b
$ Named :: [String] -> Args
Named {required :: [String]
required = ["s"]}
dirtTarget :: Target
dirtTarget :: Target
dirtTarget = Target :: String
-> String -> Int -> Double -> Maybe Arc -> Schedule -> Target
Target {oName :: String
oName = "Dirt",
oAddress :: String
oAddress = "127.0.0.1",
oPort :: Int
oPort = 7771,
oLatency :: Double
oLatency = 0.02,
oWindow :: Maybe Arc
oWindow = Maybe Arc
forall a. Maybe a
Nothing,
oSchedule :: Schedule
oSchedule = StampStyle -> Schedule
Pre StampStyle
MessageStamp
}
dirtShape :: OSC
dirtShape :: OSC
dirtShape = String -> Args -> OSC
OSC "/play" (Args -> OSC) -> Args -> OSC
forall a b. (a -> b) -> a -> b
$ [(String, Maybe Value)] -> Args
ArgList [("sec", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Int -> Value
VI 0),
("usec", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Int -> Value
VI 0),
("cps", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
VF 0),
("s", Maybe Value
forall a. Maybe a
Nothing),
("offset", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
VF 0),
("begin", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
VF 0),
("end", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
VF 1),
("speed", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
VF 1),
("pan", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
VF 0.5),
("velocity", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
VF 0.5),
("vowel", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ String -> Value
VS ""),
("cutoff", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
VF 0),
("resonance", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
VF 0),
("accelerate", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
VF 0),
("shape", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
VF 0),
("kriole", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Int -> Value
VI 0),
("gain", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
VF 1),
("cut", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Int -> Value
VI 0),
("delay", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
VF 0),
("delaytime", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
VF (-1)),
("delayfeedback", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
VF (-1)),
("crush", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
VF 0),
("coarse", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Int -> Value
VI 0),
("hcutoff", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
VF 0),
("hresonance", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
VF 0),
("bandf", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
VF 0),
("bandq", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
VF 0),
("unit", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ String -> Value
VS "rate"),
("loop", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
VF 0),
("n", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
VF 0),
("attack", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
VF (-1)),
("hold", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
VF 0),
("release", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
VF (-1)),
("orbit", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Int -> Value
VI 0),
("id", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Int -> Value
VI 0)
]
startStream :: Config -> [(Target, [OSC])] -> IO Stream
startStream :: Config -> [(Target, [OSC])] -> IO Stream
startStream config :: Config
config oscmap :: [(Target, [OSC])]
oscmap
= do [Cx]
cxs <- ((Target, [OSC]) -> IO Cx) -> [(Target, [OSC])] -> IO [Cx]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(target :: Target
target, os :: [OSC]
os) -> do UDP
u <- String -> Int -> IO UDP
O.openUDP (Target -> String
oAddress Target
target) (Target -> Int
oPort Target
target)
Cx -> IO Cx
forall (m :: * -> *) a. Monad m => a -> m a
return (Cx -> IO Cx) -> Cx -> IO Cx
forall a b. (a -> b) -> a -> b
$ Cx :: Target -> UDP -> [OSC] -> Cx
Cx {cxUDP :: UDP
cxUDP = UDP
u, cxTarget :: Target
cxTarget = Target
target, cxOSCs :: [OSC]
cxOSCs = [OSC]
os}
) [(Target, [OSC])]
oscmap
MVar StateMap
sMapMV <- StateMap -> IO (MVar StateMap)
forall a. a -> IO (MVar a)
newMVar StateMap
forall k a. Map k a
Map.empty
MVar PlayMap
pMapMV <- PlayMap -> IO (MVar PlayMap)
forall a. a -> IO (MVar a)
newMVar PlayMap
forall k a. Map k a
Map.empty
MVar (ControlPattern -> ControlPattern)
globalFMV <- (ControlPattern -> ControlPattern)
-> IO (MVar (ControlPattern -> ControlPattern))
forall a. a -> IO (MVar a)
newMVar ControlPattern -> ControlPattern
forall a. a -> a
id
Maybe ThreadId
listenTid <- MVar StateMap -> Config -> IO (Maybe ThreadId)
ctrlListen MVar StateMap
sMapMV Config
config
MVar Tempo
tempoMV <- IO (MVar Tempo)
forall a. IO (MVar a)
newEmptyMVar
let stream :: Stream
stream = Stream :: Config
-> MVar StateMap
-> Maybe ThreadId
-> MVar PlayMap
-> MVar Tempo
-> MVar (ControlPattern -> ControlPattern)
-> [Cx]
-> Stream
Stream {sConfig :: Config
sConfig = Config
config,
sInput :: MVar StateMap
sInput = MVar StateMap
sMapMV,
sListenTid :: Maybe ThreadId
sListenTid = Maybe ThreadId
listenTid,
sPMapMV :: MVar PlayMap
sPMapMV = MVar PlayMap
pMapMV,
sTempoMV :: MVar Tempo
sTempoMV = MVar Tempo
tempoMV,
sGlobalFMV :: MVar (ControlPattern -> ControlPattern)
sGlobalFMV = MVar (ControlPattern -> ControlPattern)
globalFMV,
sCxs :: [Cx]
sCxs = [Cx]
cxs
}
[ThreadId]
_ <- Config -> MVar Tempo -> (State -> IO ()) -> IO [ThreadId]
T.clocked Config
config MVar Tempo
tempoMV ((State -> IO ()) -> IO [ThreadId])
-> (State -> IO ()) -> IO [ThreadId]
forall a b. (a -> b) -> a -> b
$ Stream -> State -> IO ()
onTick Stream
stream
Stream -> IO Stream
forall (m :: * -> *) a. Monad m => a -> m a
return Stream
stream
startTidal :: Target -> Config -> IO Stream
startTidal :: Target -> Config -> IO Stream
startTidal target :: Target
target config :: Config
config = Config -> [(Target, [OSC])] -> IO Stream
startStream Config
config [(Target
target, [OSC
superdirtShape])]
startMulti :: [Target] -> Config -> IO ()
startMulti :: [Target] -> Config -> IO ()
startMulti _ _ = String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "startMulti has been removed, please check the latest documentation on tidalcycles.org"
toDatum :: Value -> O.Datum
toDatum :: Value -> Datum
toDatum (VF x :: Double
x) = Double -> Datum
forall n. Real n => n -> Datum
O.float Double
x
toDatum (VI x :: Int
x) = Int -> Datum
forall n. Integral n => n -> Datum
O.int32 Int
x
toDatum (VS x :: String
x) = String -> Datum
O.string String
x
toDatum (VR x :: Rational
x) = Double -> Datum
forall n. Real n => n -> Datum
O.float (Double -> Datum) -> Double -> Datum
forall a b. (a -> b) -> a -> b
$ ((Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
x) :: Double)
toDatum (VB True) = Int -> Datum
forall n. Integral n => n -> Datum
O.int32 (1 :: Int)
toDatum (VB False) = Int -> Datum
forall n. Integral n => n -> Datum
O.int32 (0 :: Int)
toDatum (VX xs :: [Word8]
xs) = BLOB -> Datum
O.Blob (BLOB -> Datum) -> BLOB -> Datum
forall a b. (a -> b) -> a -> b
$ [Word8] -> BLOB
O.blob_pack [Word8]
xs
toData :: OSC -> Event ControlMap -> Maybe [O.Datum]
toData :: OSC -> Event ControlMap -> Maybe [Datum]
toData (OSC {args :: OSC -> Args
args = ArgList as :: [(String, Maybe Value)]
as}) e :: Event ControlMap
e = ([Value] -> [Datum]) -> Maybe [Value] -> Maybe [Datum]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Value -> Datum) -> [Value] -> [Datum]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Datum
toDatum) (Maybe [Value] -> Maybe [Datum]) -> Maybe [Value] -> Maybe [Datum]
forall a b. (a -> b) -> a -> b
$ [Maybe Value] -> Maybe [Value]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Maybe Value] -> Maybe [Value]) -> [Maybe Value] -> Maybe [Value]
forall a b. (a -> b) -> a -> b
$ ((String, Maybe Value) -> Maybe Value)
-> [(String, Maybe Value)] -> [Maybe Value]
forall a b. (a -> b) -> [a] -> [b]
map (\(n :: String
n,v :: Maybe Value
v) -> String -> ControlMap -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
n (Event ControlMap -> ControlMap
forall a b. EventF a b -> b
value Event ControlMap
e) Maybe Value -> Maybe Value -> Maybe Value
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Value
v) [(String, Maybe Value)]
as
toData (OSC {args :: OSC -> Args
args = Named rqrd :: [String]
rqrd}) e :: Event ControlMap
e
| [String] -> Bool
hasRequired [String]
rqrd = [Datum] -> Maybe [Datum]
forall a. a -> Maybe a
Just ([Datum] -> Maybe [Datum]) -> [Datum] -> Maybe [Datum]
forall a b. (a -> b) -> a -> b
$ ((String, Value) -> [Datum]) -> [(String, Value)] -> [Datum]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(n :: String
n,v :: Value
v) -> [String -> Datum
O.string String
n, Value -> Datum
toDatum Value
v]) ([(String, Value)] -> [Datum]) -> [(String, Value)] -> [Datum]
forall a b. (a -> b) -> a -> b
$ ControlMap -> [(String, Value)]
forall k a. Map k a -> [(k, a)]
Map.toList (ControlMap -> [(String, Value)])
-> ControlMap -> [(String, Value)]
forall a b. (a -> b) -> a -> b
$ Event ControlMap -> ControlMap
forall a b. EventF a b -> b
value Event ControlMap
e
| Bool
otherwise = Maybe [Datum]
forall a. Maybe a
Nothing
where hasRequired :: [String] -> Bool
hasRequired [] = Bool
True
hasRequired xs :: [String]
xs = [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> Bool) -> [String] -> Bool
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
ks)) [String]
xs
ks :: [String]
ks = ControlMap -> [String]
forall k a. Map k a -> [k]
Map.keys (Event ControlMap -> ControlMap
forall a b. EventF a b -> b
value Event ControlMap
e)
substitutePath :: String -> ControlMap -> Maybe String
substitutePath :: String -> ControlMap -> Maybe String
substitutePath str :: String
str cm :: ControlMap
cm = String -> Maybe String
parse String
str
where parse :: String -> Maybe String
parse [] = String -> Maybe String
forall a. a -> Maybe a
Just []
parse ('{':xs :: String
xs) = String -> Maybe String
parseWord String
xs
parse (x :: Char
x:xs :: String
xs) = do String
xs' <- String -> Maybe String
parse String
xs
String -> Maybe String
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:String
xs')
parseWord :: String -> Maybe String
parseWord xs :: String
xs | String
b String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== [] = ControlMap -> String -> Maybe String
getString ControlMap
cm String
a
| Bool
otherwise = do String
v <- ControlMap -> String -> Maybe String
getString ControlMap
cm String
a
String
xs' <- String -> Maybe String
parse (ShowS
forall a. [a] -> [a]
tail String
b)
String -> Maybe String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
xs'
where (a :: String
a,b :: String
b) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '}') String
xs
getString :: ControlMap -> String -> Maybe String
getString :: ControlMap -> String -> Maybe String
getString cm :: ControlMap
cm s :: String
s = Maybe String -> Maybe String
defaultValue (Maybe String -> Maybe String) -> Maybe String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Value -> String
simpleShow (Value -> String) -> Maybe Value -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ControlMap -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
s ControlMap
cm
where simpleShow :: Value -> String
simpleShow :: Value -> String
simpleShow (VS str :: String
str) = String
str
simpleShow (VI i :: Int
i) = Int -> String
forall a. Show a => a -> String
show Int
i
simpleShow (VF f :: Double
f) = Double -> String
forall a. Show a => a -> String
show Double
f
simpleShow (VR r :: Rational
r) = Rational -> String
forall a. Show a => a -> String
show Rational
r
simpleShow (VB b :: Bool
b) = Bool -> String
forall a. Show a => a -> String
show Bool
b
simpleShow (VX xs :: [Word8]
xs) = [Word8] -> String
forall a. Show a => a -> String
show [Word8]
xs
(_, dflt :: String
dflt) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '=') String
s
defaultValue :: Maybe String -> Maybe String
defaultValue :: Maybe String -> Maybe String
defaultValue Nothing | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
dflt = Maybe String
forall a. Maybe a
Nothing
| Bool
otherwise = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. [a] -> [a]
tail String
dflt
defaultValue x :: Maybe String
x = Maybe String
x
playStack :: PlayMap -> ControlPattern
playStack :: PlayMap -> ControlPattern
playStack pMap :: PlayMap
pMap = [ControlPattern] -> ControlPattern
forall a. [Pattern a] -> Pattern a
stack ([ControlPattern] -> ControlPattern)
-> [ControlPattern] -> ControlPattern
forall a b. (a -> b) -> a -> b
$ (PlayState -> ControlPattern) -> [PlayState] -> [ControlPattern]
forall a b. (a -> b) -> [a] -> [b]
map PlayState -> ControlPattern
pattern [PlayState]
active
where active :: [PlayState]
active = (PlayState -> Bool) -> [PlayState] -> [PlayState]
forall a. (a -> Bool) -> [a] -> [a]
filter (\pState :: PlayState
pState -> if PlayMap -> Bool
forall k. Map k PlayState -> Bool
hasSolo PlayMap
pMap
then PlayState -> Bool
solo PlayState
pState
else Bool -> Bool
not (PlayState -> Bool
mute PlayState
pState)
) ([PlayState] -> [PlayState]) -> [PlayState] -> [PlayState]
forall a b. (a -> b) -> a -> b
$ PlayMap -> [PlayState]
forall k a. Map k a -> [a]
Map.elems PlayMap
pMap
toOSC :: Double -> Event ControlMap -> T.Tempo -> OSC -> Maybe (Double, O.Message)
toOSC :: Double
-> Event ControlMap -> Tempo -> OSC -> Maybe (Double, Message)
toOSC latency :: Double
latency e :: Event ControlMap
e tempo :: Tempo
tempo osc :: OSC
osc = do [Datum]
vs <- OSC -> Event ControlMap -> Maybe [Datum]
toData OSC
osc Event ControlMap
addExtra
String
mungedPath <- String -> ControlMap -> Maybe String
substitutePath (OSC -> String
path OSC
osc) (Event ControlMap -> ControlMap
forall a b. EventF a b -> b
value Event ControlMap
e)
(Double, Message) -> Maybe (Double, Message)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
ts, String -> [Datum] -> Message
O.Message String
mungedPath [Datum]
vs)
where on :: Double
on = Tempo -> Rational -> Double
sched Tempo
tempo (Rational -> Double) -> Rational -> Double
forall a b. (a -> b) -> a -> b
$ Arc -> Rational
forall a. ArcF a -> a
start (Arc -> Rational) -> Arc -> Rational
forall a b. (a -> b) -> a -> b
$ Event ControlMap -> Arc
forall a. Event a -> Arc
wholeOrPart Event ControlMap
e
off :: Double
off = Tempo -> Rational -> Double
sched Tempo
tempo (Rational -> Double) -> Rational -> Double
forall a b. (a -> b) -> a -> b
$ Arc -> Rational
forall a. ArcF a -> a
stop (Arc -> Rational) -> Arc -> Rational
forall a b. (a -> b) -> a -> b
$ Event ControlMap -> Arc
forall a. Event a -> Arc
wholeOrPart Event ControlMap
e
delta :: Double
delta = Double
off Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
on
addExtra :: Event ControlMap
addExtra = (\v :: ControlMap
v -> (ControlMap -> ControlMap -> ControlMap
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union ControlMap
v ControlMap
extra)) (ControlMap -> ControlMap) -> Event ControlMap -> Event ControlMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event ControlMap
e
extra :: ControlMap
extra = [(String, Value)] -> ControlMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [("cps", (Double -> Value
VF (Double -> Value) -> Double -> Value
forall a b. (a -> b) -> a -> b
$ Tempo -> Double
T.cps Tempo
tempo)),
("delta", Double -> Value
VF Double
delta),
("cycle", Double -> Value
VF (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Rational -> Double) -> Rational -> Double
forall a b. (a -> b) -> a -> b
$ Arc -> Rational
forall a. ArcF a -> a
start (Arc -> Rational) -> Arc -> Rational
forall a b. (a -> b) -> a -> b
$ Event ControlMap -> Arc
forall a. Event a -> Arc
wholeOrPart Event ControlMap
e))
]
ts :: Double
ts = Double
on Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
nudge Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
latency
nudge :: Double
nudge = Maybe Double -> Double
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Double -> Double) -> Maybe Double -> Double
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Double
getF (Value -> Maybe Double) -> Value -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe (Double -> Value
VF 0) (Maybe Value -> Value) -> Maybe Value -> Value
forall a b. (a -> b) -> a -> b
$ String -> ControlMap -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup "nudge" (ControlMap -> Maybe Value) -> ControlMap -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Event ControlMap -> ControlMap
forall a b. EventF a b -> b
value Event ControlMap
e
doCps :: MVar T.Tempo -> (Double, Maybe Value) -> IO ()
doCps :: MVar Tempo -> (Double, Maybe Value) -> IO ()
doCps tempoMV :: MVar Tempo
tempoMV (d :: Double
d, Just (VF cps :: Double
cps)) = do ThreadId
_ <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do Int -> IO ()
threadDelay (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double
d Double -> Double -> Double
forall a. Num a => a -> a -> a
* 1000000
Tempo
_ <- MVar Tempo -> Double -> IO Tempo
T.setCps MVar Tempo
tempoMV (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max 0.00001 Double
cps)
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
doCps _ _ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
onTick :: Stream -> T.State -> IO ()
onTick :: Stream -> State -> IO ()
onTick stream :: Stream
stream st :: State
st
= do Bool -> Stream -> State -> IO ()
doTick Bool
False Stream
stream State
st
processCps :: T.Tempo -> [Event ControlMap] -> ([(T.Tempo, Event ControlMap)], T.Tempo)
processCps :: Tempo -> [Event ControlMap] -> ([(Tempo, Event ControlMap)], Tempo)
processCps t :: Tempo
t [] = ([], Tempo
t)
processCps t :: Tempo
t (e :: Event ControlMap
e:evs :: [Event ControlMap]
evs) = (((Tempo
t', Event ControlMap
e)(Tempo, Event ControlMap)
-> [(Tempo, Event ControlMap)] -> [(Tempo, Event ControlMap)]
forall a. a -> [a] -> [a]
:[(Tempo, Event ControlMap)]
es'), Tempo
t'')
where cps' :: Maybe Double
cps' = do Value
x <- String -> ControlMap -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup "cps" (ControlMap -> Maybe Value) -> ControlMap -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Event ControlMap -> ControlMap
forall a b. EventF a b -> b
value Event ControlMap
e
Value -> Maybe Double
getF Value
x
t' :: Tempo
t' = (Tempo -> (Double -> Tempo) -> Maybe Double -> Tempo
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Tempo
t (\newCps :: Double
newCps -> Tempo -> Double -> Rational -> Tempo
T.changeTempo' Tempo
t Double
newCps (Event ControlMap -> Rational
forall a. Event a -> Rational
eventPartStart Event ControlMap
e)) Maybe Double
cps')
(es' :: [(Tempo, Event ControlMap)]
es', t'' :: Tempo
t'') = Tempo -> [Event ControlMap] -> ([(Tempo, Event ControlMap)], Tempo)
processCps Tempo
t' [Event ControlMap]
evs
streamOnce :: Stream -> ControlPattern -> IO ()
streamOnce :: Stream -> ControlPattern -> IO ()
streamOnce st :: Stream
st p :: ControlPattern
p = do Int
i <- (StdGen -> (Int, StdGen)) -> IO Int
forall a. (StdGen -> (a, StdGen)) -> IO a
getStdRandom ((StdGen -> (Int, StdGen)) -> IO Int)
-> (StdGen -> (Int, StdGen)) -> IO Int
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> StdGen -> (Int, StdGen)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (0, 8192)
Stream -> ControlPattern -> IO ()
streamFirst Stream
st (ControlPattern -> IO ()) -> ControlPattern -> IO ()
forall a b. (a -> b) -> a -> b
$ Rational -> ControlPattern -> ControlPattern
forall a. Rational -> Pattern a -> Pattern a
rotL (Int -> Rational
forall a. Real a => a -> Rational
toRational (Int
i :: Int)) ControlPattern
p
streamFirst :: Stream -> ControlPattern -> IO ()
streamFirst :: Stream -> ControlPattern -> IO ()
streamFirst stream :: Stream
stream pat :: ControlPattern
pat = do Double
now <- IO Double
forall (m :: * -> *). MonadIO m => m Double
O.time
Tempo
tempo <- MVar Tempo -> IO Tempo
forall a. MVar a -> IO a
readMVar (Stream -> MVar Tempo
sTempoMV Stream
stream)
MVar PlayMap
pMapMV <- PlayMap -> IO (MVar PlayMap)
forall a. a -> IO (MVar a)
newMVar (PlayMap -> IO (MVar PlayMap)) -> PlayMap -> IO (MVar PlayMap)
forall a b. (a -> b) -> a -> b
$ String -> PlayState -> PlayMap
forall k a. k -> a -> Map k a
Map.singleton "fake"
(PlayState :: ControlPattern -> Bool -> Bool -> [ControlPattern] -> PlayState
PlayState {pattern :: ControlPattern
pattern = ControlPattern
pat,
mute :: Bool
mute = Bool
False,
solo :: Bool
solo = Bool
False,
history :: [ControlPattern]
history = []
}
)
let cps :: Double
cps = Tempo -> Double
T.cps Tempo
tempo
state :: State
state = State :: Int -> Double -> (Double, Double) -> Arc -> Bool -> State
T.State {ticks :: Int
T.ticks = 0,
start :: Double
T.start = Double
now,
nowTimespan :: (Double, Double)
T.nowTimespan = (Double
now, Double
now Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
cps)),
nowArc :: Arc
T.nowArc = (Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc 0 1)
}
Bool -> Stream -> State -> IO ()
doTick Bool
True (Stream
stream {sPMapMV :: MVar PlayMap
sPMapMV = MVar PlayMap
pMapMV}) State
state
doTick :: Bool -> Stream -> T.State -> IO ()
doTick :: Bool -> Stream -> State -> IO ()
doTick fake :: Bool
fake stream :: Stream
stream st :: State
st =
do Tempo
tempo <- MVar Tempo -> IO Tempo
forall a. MVar a -> IO a
takeMVar (Stream -> MVar Tempo
sTempoMV Stream
stream)
PlayMap
pMap <- MVar PlayMap -> IO PlayMap
forall a. MVar a -> IO a
readMVar (Stream -> MVar PlayMap
sPMapMV Stream
stream)
StateMap
sMap <- MVar StateMap -> IO StateMap
forall a. MVar a -> IO a
readMVar (Stream -> MVar StateMap
sInput Stream
stream)
ControlPattern -> ControlPattern
sGlobalF <- MVar (ControlPattern -> ControlPattern)
-> IO (ControlPattern -> ControlPattern)
forall a. MVar a -> IO a
readMVar (Stream -> MVar (ControlPattern -> ControlPattern)
sGlobalFMV Stream
stream)
let config :: Config
config = Stream -> Config
sConfig Stream
stream
cxs :: [Cx]
cxs = Stream -> [Cx]
sCxs Stream
stream
cycleNow :: Rational
cycleNow = Tempo -> Double -> Rational
T.timeToCycles Tempo
tempo (Double -> Rational) -> Double -> Rational
forall a b. (a -> b) -> a -> b
$ State -> Double
T.start State
st
patstack :: ControlPattern
patstack = ControlPattern -> ControlPattern
sGlobalF (ControlPattern -> ControlPattern)
-> ControlPattern -> ControlPattern
forall a b. (a -> b) -> a -> b
$ PlayMap -> ControlPattern
playStack PlayMap
pMap
pat :: ControlPattern
pat | Bool
fake = (Rational -> Rational) -> ControlPattern -> ControlPattern
forall a. (Rational -> Rational) -> Pattern a -> Pattern a
withResultTime (Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
cycleNow) ControlPattern
patstack
| Bool
otherwise = ControlPattern
patstack
frameEnd :: Double
frameEnd = (Double, Double) -> Double
forall a b. (a, b) -> b
snd ((Double, Double) -> Double) -> (Double, Double) -> Double
forall a b. (a -> b) -> a -> b
$ State -> (Double, Double)
T.nowTimespan State
st
sMap' :: StateMap
sMap' = String -> Pattern Value -> StateMap -> StateMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert "_cps" (Value -> Pattern Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Pattern Value) -> Value -> Pattern Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
VF (Double -> Value) -> Double -> Value
forall a b. (a -> b) -> a -> b
$ Tempo -> Double
T.cps Tempo
tempo) StateMap
sMap
filterOns :: [Event a] -> [Event a]
filterOns = (Event a -> Bool) -> [Event a] -> [Event a]
forall a. (a -> Bool) -> [a] -> [a]
filter Event a -> Bool
forall a. Event a -> Bool
eventHasOnset
extraLatency :: Double
extraLatency | Bool
fake = 0
| Bool
otherwise = Config -> Double
cFrameTimespan Config
config Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Tempo -> Double
T.nudged Tempo
tempo
es :: [Event ControlMap]
es = (Event ControlMap -> Rational)
-> [Event ControlMap] -> [Event ControlMap]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Arc -> Rational
forall a. ArcF a -> a
start (Arc -> Rational)
-> (Event ControlMap -> Arc) -> Event ControlMap -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event ControlMap -> Arc
forall a b. EventF a b -> a
part) ([Event ControlMap] -> [Event ControlMap])
-> [Event ControlMap] -> [Event ControlMap]
forall a b. (a -> b) -> a -> b
$ [Event ControlMap] -> [Event ControlMap]
forall a. [Event a] -> [Event a]
filterOns ([Event ControlMap] -> [Event ControlMap])
-> [Event ControlMap] -> [Event ControlMap]
forall a b. (a -> b) -> a -> b
$ ControlPattern -> Query ControlMap
forall a. Pattern a -> Query a
query ControlPattern
pat (State :: Arc -> StateMap -> State
State {arc :: Arc
arc = State -> Arc
T.nowArc State
st,
controls :: StateMap
controls = StateMap
sMap'
}
)
on :: Event a -> Tempo -> Double
on e :: Event a
e tempo'' :: Tempo
tempo'' = (Tempo -> Rational -> Double
sched Tempo
tempo'' (Rational -> Double) -> Rational -> Double
forall a b. (a -> b) -> a -> b
$ Arc -> Rational
forall a. ArcF a -> a
start (Arc -> Rational) -> Arc -> Rational
forall a b. (a -> b) -> a -> b
$ Event a -> Arc
forall a. Event a -> Arc
wholeOrPart Event a
e)
(tes :: [(Tempo, Event ControlMap)]
tes, tempo' :: Tempo
tempo') = Tempo -> [Event ControlMap] -> ([(Tempo, Event ControlMap)], Tempo)
processCps Tempo
tempo [Event ControlMap]
es
(Cx -> IO ()) -> [Cx] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\cx :: Cx
cx@(Cx target :: Target
target _ oscs :: [OSC]
oscs) ->
(do let latency :: Double
latency = Target -> Double
oLatency Target
target Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
extraLatency
ms :: [(Double, Message)]
ms = ((Tempo, Event ControlMap) -> [(Double, Message)])
-> [(Tempo, Event ControlMap)] -> [(Double, Message)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(t :: Tempo
t, e :: Event ControlMap
e) ->
if (Bool
fake Bool -> Bool -> Bool
|| (Event ControlMap -> Tempo -> Double
forall a. Event a -> Tempo -> Double
on Event ControlMap
e Tempo
t) Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
frameEnd)
then [Maybe (Double, Message)] -> [(Double, Message)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Double, Message)] -> [(Double, Message)])
-> [Maybe (Double, Message)] -> [(Double, Message)]
forall a b. (a -> b) -> a -> b
$ (OSC -> Maybe (Double, Message))
-> [OSC] -> [Maybe (Double, Message)]
forall a b. (a -> b) -> [a] -> [b]
map (Double
-> Event ControlMap -> Tempo -> OSC -> Maybe (Double, Message)
toOSC Double
latency Event ControlMap
e Tempo
t) [OSC]
oscs
else []
) [(Tempo, Event ControlMap)]
tes
IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (IO () -> (SomeException -> IO ()) -> IO ())
-> IO () -> (SomeException -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ ((Double, Message) -> IO ()) -> [(Double, Message)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Cx -> (Double, Message) -> IO ()
send Cx
cx) [(Double, Message)]
ms
)
(\(SomeException
e ::E.SomeException)
-> String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Failed to send. Is the '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Target -> String
oName Target
target String -> ShowS
forall a. [a] -> [a] -> [a]
++ "' target running? " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SomeException -> String
forall a. Show a => a -> String
show SomeException
e
)
) [Cx]
cxs
MVar Tempo -> Tempo -> IO ()
forall a. MVar a -> a -> IO ()
putMVar (Stream -> MVar Tempo
sTempoMV Stream
stream) Tempo
tempo'
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
send :: Cx -> (Double, O.Message) -> IO ()
send :: Cx -> (Double, Message) -> IO ()
send cx :: Cx
cx (time :: Double
time, m :: Message
m)
| Target -> Schedule
oSchedule Target
target Schedule -> Schedule -> Bool
forall a. Eq a => a -> a -> Bool
== StampStyle -> Schedule
Pre StampStyle
BundleStamp = UDP -> Bundle -> IO ()
forall t. Transport t => t -> Bundle -> IO ()
O.sendBundle UDP
u (Bundle -> IO ()) -> Bundle -> IO ()
forall a b. (a -> b) -> a -> b
$ Double -> [Message] -> Bundle
O.Bundle Double
time [Message
m]
| Target -> Schedule
oSchedule Target
target Schedule -> Schedule -> Bool
forall a. Eq a => a -> a -> Bool
== StampStyle -> Schedule
Pre StampStyle
MessageStamp = UDP -> Message -> IO ()
forall t. Transport t => t -> Message -> IO ()
O.sendMessage UDP
u (Message -> IO ()) -> Message -> IO ()
forall a b. (a -> b) -> a -> b
$ Message -> Message
addtime Message
m
| Bool
otherwise = do ThreadId
_ <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do Double
now <- IO Double
forall (m :: * -> *). MonadIO m => m Double
O.time
Int -> IO ()
threadDelay (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ (Double
time Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
now) Double -> Double -> Double
forall a. Num a => a -> a -> a
* 1000000
UDP -> Message -> IO ()
forall t. Transport t => t -> Message -> IO ()
O.sendMessage UDP
u Message
m
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where addtime :: Message -> Message
addtime (O.Message mpath :: String
mpath params :: [Datum]
params) = String -> [Datum] -> Message
O.Message String
mpath ((Int -> Datum
forall n. Integral n => n -> Datum
O.int32 Int
sec)Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
:((Int -> Datum
forall n. Integral n => n -> Datum
O.int32 Int
usec)Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
:[Datum]
params))
ut :: Double
ut = Double -> Double
forall n. Num n => n -> n
O.ntpr_to_ut Double
time
sec :: Int
sec :: Int
sec = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
ut
usec :: Int
usec :: Int
usec = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ 1000000 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
ut Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sec))
u :: UDP
u = Cx -> UDP
cxUDP Cx
cx
target :: Target
target = Cx -> Target
cxTarget Cx
cx
sched :: T.Tempo -> Rational -> Double
sched :: Tempo -> Rational -> Double
sched tempo :: Tempo
tempo c :: Rational
c = ((Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Rational -> Double) -> Rational -> Double
forall a b. (a -> b) -> a -> b
$ Rational
c Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- (Tempo -> Rational
T.atCycle Tempo
tempo)) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Tempo -> Double
T.cps Tempo
tempo)
Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Tempo -> Double
T.atTime Tempo
tempo)
streamNudgeAll :: Stream -> Double -> IO ()
streamNudgeAll :: Stream -> Double -> IO ()
streamNudgeAll s :: Stream
s nudge :: Double
nudge = do Tempo
tempo <- MVar Tempo -> IO Tempo
forall a. MVar a -> IO a
takeMVar (MVar Tempo -> IO Tempo) -> MVar Tempo -> IO Tempo
forall a b. (a -> b) -> a -> b
$ Stream -> MVar Tempo
sTempoMV Stream
s
MVar Tempo -> Tempo -> IO ()
forall a. MVar a -> a -> IO ()
putMVar (Stream -> MVar Tempo
sTempoMV Stream
s) (Tempo -> IO ()) -> Tempo -> IO ()
forall a b. (a -> b) -> a -> b
$ Tempo
tempo {nudged :: Double
T.nudged = Double
nudge}
streamResetCycles :: Stream -> IO ()
streamResetCycles :: Stream -> IO ()
streamResetCycles s :: Stream
s = do Tempo
_ <- MVar Tempo -> IO Tempo
T.resetCycles (Stream -> MVar Tempo
sTempoMV Stream
s)
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
hasSolo :: Map.Map k PlayState -> Bool
hasSolo :: Map k PlayState -> Bool
hasSolo = (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 1) (Int -> Bool)
-> (Map k PlayState -> Int) -> Map k PlayState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PlayState] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([PlayState] -> Int)
-> (Map k PlayState -> [PlayState]) -> Map k PlayState -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PlayState -> Bool) -> [PlayState] -> [PlayState]
forall a. (a -> Bool) -> [a] -> [a]
filter PlayState -> Bool
solo ([PlayState] -> [PlayState])
-> (Map k PlayState -> [PlayState])
-> Map k PlayState
-> [PlayState]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k PlayState -> [PlayState]
forall k a. Map k a -> [a]
Map.elems
streamList :: Stream -> IO ()
streamList :: Stream -> IO ()
streamList s :: Stream
s = do PlayMap
pMap <- MVar PlayMap -> IO PlayMap
forall a. MVar a -> IO a
readMVar (Stream -> MVar PlayMap
sPMapMV Stream
s)
let hs :: Bool
hs = PlayMap -> Bool
forall k. Map k PlayState -> Bool
hasSolo PlayMap
pMap
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ ((String, PlayState) -> String) -> [(String, PlayState)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Bool -> (String, PlayState) -> String
showKV Bool
hs) ([(String, PlayState)] -> String)
-> [(String, PlayState)] -> String
forall a b. (a -> b) -> a -> b
$ PlayMap -> [(String, PlayState)]
forall k a. Map k a -> [(k, a)]
Map.toList PlayMap
pMap
where showKV :: Bool -> (PatId, PlayState) -> String
showKV :: Bool -> (String, PlayState) -> String
showKV True (k :: String
k, (PlayState {solo :: PlayState -> Bool
solo = Bool
True})) = String
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ " - solo\n"
showKV True (k :: String
k, _) = "(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")\n"
showKV False (k :: String
k, (PlayState {solo :: PlayState -> Bool
solo = Bool
False})) = String
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\n"
showKV False (k :: String
k, _) = "(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ ") - muted\n"
streamReplace :: Show a => Stream -> a -> ControlPattern -> IO ()
streamReplace :: Stream -> a -> ControlPattern -> IO ()
streamReplace s :: Stream
s k :: a
k !ControlPattern
pat
= IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (do let x :: [Event ControlMap]
x = ControlPattern -> Arc -> [Event ControlMap]
forall a. Pattern a -> Arc -> [Event a]
queryArc ControlPattern
pat (Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc 0 0)
Tempo
tempo <- MVar Tempo -> IO Tempo
forall a. MVar a -> IO a
readMVar (MVar Tempo -> IO Tempo) -> MVar Tempo -> IO Tempo
forall a b. (a -> b) -> a -> b
$ Stream -> MVar Tempo
sTempoMV Stream
s
StateMap
input <- MVar StateMap -> IO StateMap
forall a. MVar a -> IO a
takeMVar (MVar StateMap -> IO StateMap) -> MVar StateMap -> IO StateMap
forall a b. (a -> b) -> a -> b
$ Stream -> MVar StateMap
sInput Stream
s
Double
now <- IO Double
forall (m :: * -> *). MonadIO m => m Double
O.time
let cyc :: Rational
cyc = Tempo -> Double -> Rational
T.timeToCycles Tempo
tempo Double
now
MVar StateMap -> StateMap -> IO ()
forall a. MVar a -> a -> IO ()
putMVar (Stream -> MVar StateMap
sInput Stream
s) (StateMap -> IO ()) -> StateMap -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> Pattern Value -> StateMap -> StateMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ("_t_all") (Value -> Pattern Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Pattern Value) -> Value -> Pattern Value
forall a b. (a -> b) -> a -> b
$ Rational -> Value
VR Rational
cyc) (StateMap -> StateMap) -> StateMap -> StateMap
forall a b. (a -> b) -> a -> b
$ String -> Pattern Value -> StateMap -> StateMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ("_t_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
k) (Value -> Pattern Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Pattern Value) -> Value -> Pattern Value
forall a b. (a -> b) -> a -> b
$ Rational -> Value
VR Rational
cyc) StateMap
input
PlayMap
pMap <- [Event ControlMap] -> IO PlayMap -> IO PlayMap
forall a b. a -> b -> b
seq [Event ControlMap]
x (IO PlayMap -> IO PlayMap) -> IO PlayMap -> IO PlayMap
forall a b. (a -> b) -> a -> b
$ MVar PlayMap -> IO PlayMap
forall a. MVar a -> IO a
takeMVar (MVar PlayMap -> IO PlayMap) -> MVar PlayMap -> IO PlayMap
forall a b. (a -> b) -> a -> b
$ Stream -> MVar PlayMap
sPMapMV Stream
s
let playState :: PlayState
playState = Maybe PlayState -> PlayState
updatePS (Maybe PlayState -> PlayState) -> Maybe PlayState -> PlayState
forall a b. (a -> b) -> a -> b
$ String -> PlayMap -> Maybe PlayState
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (a -> String
forall a. Show a => a -> String
show a
k) PlayMap
pMap
MVar PlayMap -> PlayMap -> IO ()
forall a. MVar a -> a -> IO ()
putMVar (Stream -> MVar PlayMap
sPMapMV Stream
s) (PlayMap -> IO ()) -> PlayMap -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> PlayState -> PlayMap -> PlayMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (a -> String
forall a. Show a => a -> String
show a
k) PlayState
playState PlayMap
pMap
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
)
(\(SomeException
e :: E.SomeException) -> Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Error in pattern: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SomeException -> String
forall a. Show a => a -> String
show SomeException
e
)
where updatePS :: Maybe PlayState -> PlayState
updatePS (Just playState :: PlayState
playState) = do PlayState
playState {pattern :: ControlPattern
pattern = ControlPattern
pat, history :: [ControlPattern]
history = ControlPattern
patControlPattern -> [ControlPattern] -> [ControlPattern]
forall a. a -> [a] -> [a]
:(PlayState -> [ControlPattern]
history PlayState
playState)}
updatePS Nothing = ControlPattern -> Bool -> Bool -> [ControlPattern] -> PlayState
PlayState ControlPattern
pat Bool
False Bool
False [ControlPattern
pat]
streamMute :: Show a => Stream -> a -> IO ()
streamMute :: Stream -> a -> IO ()
streamMute s :: Stream
s k :: a
k = Stream -> String -> (PlayState -> PlayState) -> IO ()
withPatId Stream
s (a -> String
forall a. Show a => a -> String
show a
k) (\x :: PlayState
x -> PlayState
x {mute :: Bool
mute = Bool
True})
streamMutes :: Show a => Stream -> [a] -> IO ()
streamMutes :: Stream -> [a] -> IO ()
streamMutes s :: Stream
s ks :: [a]
ks = Stream -> [String] -> (PlayState -> PlayState) -> IO ()
withPatIds Stream
s ((a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
forall a. Show a => a -> String
show [a]
ks) (\x :: PlayState
x -> PlayState
x {mute :: Bool
mute = Bool
True})
streamUnmute :: Show a => Stream -> a -> IO ()
streamUnmute :: Stream -> a -> IO ()
streamUnmute s :: Stream
s k :: a
k = Stream -> String -> (PlayState -> PlayState) -> IO ()
withPatId Stream
s (a -> String
forall a. Show a => a -> String
show a
k) (\x :: PlayState
x -> PlayState
x {mute :: Bool
mute = Bool
False})
streamSolo :: Show a => Stream -> a -> IO ()
streamSolo :: Stream -> a -> IO ()
streamSolo s :: Stream
s k :: a
k = Stream -> String -> (PlayState -> PlayState) -> IO ()
withPatId Stream
s (a -> String
forall a. Show a => a -> String
show a
k) (\x :: PlayState
x -> PlayState
x {solo :: Bool
solo = Bool
True})
streamUnsolo :: Show a => Stream -> a -> IO ()
streamUnsolo :: Stream -> a -> IO ()
streamUnsolo s :: Stream
s k :: a
k = Stream -> String -> (PlayState -> PlayState) -> IO ()
withPatId Stream
s (a -> String
forall a. Show a => a -> String
show a
k) (\x :: PlayState
x -> PlayState
x {solo :: Bool
solo = Bool
False})
withPatId :: Stream -> PatId -> (PlayState -> PlayState) -> IO ()
withPatId :: Stream -> String -> (PlayState -> PlayState) -> IO ()
withPatId s :: Stream
s k :: String
k f :: PlayState -> PlayState
f = Stream -> [String] -> (PlayState -> PlayState) -> IO ()
withPatIds Stream
s [String
k] PlayState -> PlayState
f
withPatIds :: Stream -> [PatId] -> (PlayState -> PlayState) -> IO ()
withPatIds :: Stream -> [String] -> (PlayState -> PlayState) -> IO ()
withPatIds s :: Stream
s ks :: [String]
ks f :: PlayState -> PlayState
f
= do PlayMap
playMap <- MVar PlayMap -> IO PlayMap
forall a. MVar a -> IO a
takeMVar (MVar PlayMap -> IO PlayMap) -> MVar PlayMap -> IO PlayMap
forall a b. (a -> b) -> a -> b
$ Stream -> MVar PlayMap
sPMapMV Stream
s
let pMap' :: PlayMap
pMap' = (String -> PlayMap -> PlayMap) -> PlayMap -> [String] -> PlayMap
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((PlayState -> Maybe PlayState) -> String -> PlayMap -> PlayMap
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update (\x :: PlayState
x -> PlayState -> Maybe PlayState
forall a. a -> Maybe a
Just (PlayState -> Maybe PlayState) -> PlayState -> Maybe PlayState
forall a b. (a -> b) -> a -> b
$ PlayState -> PlayState
f PlayState
x)) PlayMap
playMap [String]
ks
MVar PlayMap -> PlayMap -> IO ()
forall a. MVar a -> a -> IO ()
putMVar (Stream -> MVar PlayMap
sPMapMV Stream
s) PlayMap
pMap'
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
streamMuteAll :: Stream -> IO ()
streamMuteAll :: Stream -> IO ()
streamMuteAll s :: Stream
s = MVar PlayMap -> (PlayMap -> IO PlayMap) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (Stream -> MVar PlayMap
sPMapMV Stream
s) ((PlayMap -> IO PlayMap) -> IO ())
-> (PlayMap -> IO PlayMap) -> IO ()
forall a b. (a -> b) -> a -> b
$ PlayMap -> IO PlayMap
forall (m :: * -> *) a. Monad m => a -> m a
return (PlayMap -> IO PlayMap)
-> (PlayMap -> PlayMap) -> PlayMap -> IO PlayMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PlayState -> PlayState) -> PlayMap -> PlayMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\x :: PlayState
x -> PlayState
x {mute :: Bool
mute = Bool
True})
streamHush :: Stream -> IO ()
streamHush :: Stream -> IO ()
streamHush s :: Stream
s = MVar PlayMap -> (PlayMap -> IO PlayMap) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (Stream -> MVar PlayMap
sPMapMV Stream
s) ((PlayMap -> IO PlayMap) -> IO ())
-> (PlayMap -> IO PlayMap) -> IO ()
forall a b. (a -> b) -> a -> b
$ PlayMap -> IO PlayMap
forall (m :: * -> *) a. Monad m => a -> m a
return (PlayMap -> IO PlayMap)
-> (PlayMap -> PlayMap) -> PlayMap -> IO PlayMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PlayState -> PlayState) -> PlayMap -> PlayMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\x :: PlayState
x -> PlayState
x {pattern :: ControlPattern
pattern = ControlPattern
forall a. Pattern a
silence, history :: [ControlPattern]
history = ControlPattern
forall a. Pattern a
silenceControlPattern -> [ControlPattern] -> [ControlPattern]
forall a. a -> [a] -> [a]
:PlayState -> [ControlPattern]
history PlayState
x})
streamUnmuteAll :: Stream -> IO ()
streamUnmuteAll :: Stream -> IO ()
streamUnmuteAll s :: Stream
s = MVar PlayMap -> (PlayMap -> IO PlayMap) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (Stream -> MVar PlayMap
sPMapMV Stream
s) ((PlayMap -> IO PlayMap) -> IO ())
-> (PlayMap -> IO PlayMap) -> IO ()
forall a b. (a -> b) -> a -> b
$ PlayMap -> IO PlayMap
forall (m :: * -> *) a. Monad m => a -> m a
return (PlayMap -> IO PlayMap)
-> (PlayMap -> PlayMap) -> PlayMap -> IO PlayMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PlayState -> PlayState) -> PlayMap -> PlayMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\x :: PlayState
x -> PlayState
x {mute :: Bool
mute = Bool
False})
streamAll :: Stream -> (ControlPattern -> ControlPattern) -> IO ()
streamAll :: Stream -> (ControlPattern -> ControlPattern) -> IO ()
streamAll s :: Stream
s f :: ControlPattern -> ControlPattern
f = do ControlPattern -> ControlPattern
_ <- MVar (ControlPattern -> ControlPattern)
-> (ControlPattern -> ControlPattern)
-> IO (ControlPattern -> ControlPattern)
forall a. MVar a -> a -> IO a
swapMVar (Stream -> MVar (ControlPattern -> ControlPattern)
sGlobalFMV Stream
s) ControlPattern -> ControlPattern
f
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
streamSet :: Valuable a => Stream -> String -> Pattern a -> IO ()
streamSet :: Stream -> String -> Pattern a -> IO ()
streamSet s :: Stream
s k :: String
k pat :: Pattern a
pat = do StateMap
sMap <- MVar StateMap -> IO StateMap
forall a. MVar a -> IO a
takeMVar (MVar StateMap -> IO StateMap) -> MVar StateMap -> IO StateMap
forall a b. (a -> b) -> a -> b
$ Stream -> MVar StateMap
sInput Stream
s
let pat' :: Pattern Value
pat' = a -> Value
forall a. Valuable a => a -> Value
toValue (a -> Value) -> Pattern a -> Pattern Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
pat
sMap' :: StateMap
sMap' = String -> Pattern Value -> StateMap -> StateMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
k Pattern Value
pat' StateMap
sMap
MVar StateMap -> StateMap -> IO ()
forall a. MVar a -> a -> IO ()
putMVar (Stream -> MVar StateMap
sInput Stream
s) (StateMap -> IO ()) -> StateMap -> IO ()
forall a b. (a -> b) -> a -> b
$ StateMap
sMap'
streamSetI :: Stream -> String -> Pattern Int -> IO ()
streamSetI :: Stream -> String -> Pattern Int -> IO ()
streamSetI = Stream -> String -> Pattern Int -> IO ()
forall a. Valuable a => Stream -> String -> Pattern a -> IO ()
streamSet
streamSetF :: Stream -> String -> Pattern Double -> IO ()
streamSetF :: Stream -> String -> Pattern Double -> IO ()
streamSetF = Stream -> String -> Pattern Double -> IO ()
forall a. Valuable a => Stream -> String -> Pattern a -> IO ()
streamSet
streamSetS :: Stream -> String -> Pattern String -> IO ()
streamSetS :: Stream -> String -> Pattern String -> IO ()
streamSetS = Stream -> String -> Pattern String -> IO ()
forall a. Valuable a => Stream -> String -> Pattern a -> IO ()
streamSet
streamSetB :: Stream -> String -> Pattern Bool -> IO ()
streamSetB :: Stream -> String -> Pattern Bool -> IO ()
streamSetB = Stream -> String -> Pattern Bool -> IO ()
forall a. Valuable a => Stream -> String -> Pattern a -> IO ()
streamSet
streamSetR :: Stream -> String -> Pattern Rational -> IO ()
streamSetR :: Stream -> String -> Pattern Rational -> IO ()
streamSetR = Stream -> String -> Pattern Rational -> IO ()
forall a. Valuable a => Stream -> String -> Pattern a -> IO ()
streamSet
ctrlListen :: MVar StateMap -> Config -> IO (Maybe ThreadId)
ctrlListen :: MVar StateMap -> Config -> IO (Maybe ThreadId)
ctrlListen sMapMV :: MVar StateMap
sMapMV c :: Config
c
| Config -> Bool
cCtrlListen Config
c = do String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Listening for controls on " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Config -> String
cCtrlAddr Config
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ ":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Config -> Int
cCtrlPort Config
c)
IO (Maybe ThreadId)
-> (SomeException -> IO (Maybe ThreadId)) -> IO (Maybe ThreadId)
forall a. IO a -> (SomeException -> IO a) -> IO a
catchAny IO (Maybe ThreadId)
run (\_ -> do String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Control listen failed. Perhaps there's already another tidal instance listening on that port?"
Maybe ThreadId -> IO (Maybe ThreadId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ThreadId
forall a. Maybe a
Nothing
)
| Bool
otherwise = Maybe ThreadId -> IO (Maybe ThreadId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ThreadId
forall a. Maybe a
Nothing
where
run :: IO (Maybe ThreadId)
run = do UDP
sock <- String -> Int -> IO UDP
O.udpServer (Config -> String
cCtrlAddr Config
c) (Config -> Int
cCtrlPort Config
c)
ThreadId
tid <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ UDP -> IO ()
forall t b. Transport t => t -> IO b
loop UDP
sock
Maybe ThreadId -> IO (Maybe ThreadId)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ThreadId -> IO (Maybe ThreadId))
-> Maybe ThreadId -> IO (Maybe ThreadId)
forall a b. (a -> b) -> a -> b
$ ThreadId -> Maybe ThreadId
forall a. a -> Maybe a
Just ThreadId
tid
loop :: t -> IO b
loop sock :: t
sock = do [Message]
ms <- t -> IO [Message]
forall t. Transport t => t -> IO [Message]
O.recvMessages t
sock
(Message -> IO ()) -> [Message] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Message -> IO ()
act [Message]
ms
t -> IO b
loop t
sock
act :: Message -> IO ()
act (O.Message x :: String
x (O.Int32 k :: Int32
k:v :: Datum
v:[]))
= Message -> IO ()
act (String -> [Datum] -> Message
O.Message String
x [String -> Datum
O.string (String -> Datum) -> String -> Datum
forall a b. (a -> b) -> a -> b
$ Int32 -> String
forall a. Show a => a -> String
show Int32
k,Datum
v])
act (O.Message _ (O.ASCII_String k :: ASCII
k:v :: Datum
v@(O.Float _):[]))
= String -> Value -> IO ()
add (ASCII -> String
O.ascii_to_string ASCII
k) (Double -> Value
VF (Double -> Value) -> Double -> Value
forall a b. (a -> b) -> a -> b
$ Maybe Double -> Double
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Double -> Double) -> Maybe Double -> Double
forall a b. (a -> b) -> a -> b
$ Datum -> Maybe Double
forall n. Floating n => Datum -> Maybe n
O.datum_floating Datum
v)
act (O.Message _ (O.ASCII_String k :: ASCII
k:O.ASCII_String v :: ASCII
v:[]))
= String -> Value -> IO ()
add (ASCII -> String
O.ascii_to_string ASCII
k) (String -> Value
VS (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$ ASCII -> String
O.ascii_to_string ASCII
v)
act (O.Message _ (O.ASCII_String k :: ASCII
k:O.Int32 v :: Int32
v:[]))
= String -> Value -> IO ()
add (ASCII -> String
O.ascii_to_string ASCII
k) (Int -> Value
VI (Int -> Value) -> Int -> Value
forall a b. (a -> b) -> a -> b
$ Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
v)
act m :: Message
m = String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Unhandled OSC: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Message -> String
forall a. Show a => a -> String
show Message
m
add :: String -> Value -> IO ()
add :: String -> Value -> IO ()
add k :: String
k v :: Value
v = do StateMap
sMap <- MVar StateMap -> IO StateMap
forall a. MVar a -> IO a
takeMVar MVar StateMap
sMapMV
MVar StateMap -> StateMap -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar StateMap
sMapMV (StateMap -> IO ()) -> StateMap -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Pattern Value -> StateMap -> StateMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
k (Value -> Pattern Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
v) StateMap
sMap
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
catchAny :: IO a -> (E.SomeException -> IO a) -> IO a
catchAny :: IO a -> (SomeException -> IO a) -> IO a
catchAny = IO a -> (SomeException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch