{-# 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, isJust, 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 TimeStamp = BundleStamp | MessageStamp | NoStamp
deriving (TimeStamp -> TimeStamp -> Bool
(TimeStamp -> TimeStamp -> Bool)
-> (TimeStamp -> TimeStamp -> Bool) -> Eq TimeStamp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeStamp -> TimeStamp -> Bool
$c/= :: TimeStamp -> TimeStamp -> Bool
== :: TimeStamp -> TimeStamp -> Bool
$c== :: TimeStamp -> TimeStamp -> Bool
Eq, Int -> TimeStamp -> ShowS
[TimeStamp] -> ShowS
TimeStamp -> String
(Int -> TimeStamp -> ShowS)
-> (TimeStamp -> String)
-> ([TimeStamp] -> ShowS)
-> Show TimeStamp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeStamp] -> ShowS
$cshowList :: [TimeStamp] -> ShowS
show :: TimeStamp -> String
$cshow :: TimeStamp -> String
showsPrec :: Int -> TimeStamp -> ShowS
$cshowsPrec :: Int -> TimeStamp -> ShowS
Show)
data Stream = Stream {Stream -> Config
sConfig :: Config,
Stream -> MVar StateMap
sInput :: MVar StateMap,
Stream -> MVar ControlPattern
sOutput :: MVar ControlPattern,
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 -> OSCTarget
cxTarget :: OSCTarget,
Cx -> UDP
cxUDP :: O.UDP
}
data OSCTarget = OSCTarget {OSCTarget -> String
oName :: String,
OSCTarget -> String
oAddress :: String,
OSCTarget -> Int
oPort :: Int,
OSCTarget -> String
oPath :: String,
OSCTarget -> Maybe [(String, Maybe Value)]
oShape :: Maybe [(String, Maybe Value)],
OSCTarget -> Double
oLatency :: Double,
OSCTarget -> [Datum]
oPreamble :: [O.Datum],
OSCTarget -> TimeStamp
oTimestamp :: TimeStamp
}
deriving Int -> OSCTarget -> ShowS
[OSCTarget] -> ShowS
OSCTarget -> String
(Int -> OSCTarget -> ShowS)
-> (OSCTarget -> String)
-> ([OSCTarget] -> ShowS)
-> Show OSCTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OSCTarget] -> ShowS
$cshowList :: [OSCTarget] -> ShowS
show :: OSCTarget -> String
$cshow :: OSCTarget -> String
showsPrec :: Int -> OSCTarget -> ShowS
$cshowsPrec :: Int -> OSCTarget -> ShowS
Show
superdirtTarget :: OSCTarget
superdirtTarget :: OSCTarget
superdirtTarget = OSCTarget :: String
-> String
-> Int
-> String
-> Maybe [(String, Maybe Value)]
-> Double
-> [Datum]
-> TimeStamp
-> OSCTarget
OSCTarget {oName :: String
oName = "SuperDirt",
oAddress :: String
oAddress = "127.0.0.1",
oPort :: Int
oPort = 57120,
oPath :: String
oPath = "/play2",
oShape :: Maybe [(String, Maybe Value)]
oShape = Maybe [(String, Maybe Value)]
forall a. Maybe a
Nothing,
oLatency :: Double
oLatency = 0.02,
oPreamble :: [Datum]
oPreamble = [],
oTimestamp :: TimeStamp
oTimestamp = TimeStamp
BundleStamp
}
dirtTarget :: OSCTarget
dirtTarget :: OSCTarget
dirtTarget = OSCTarget :: String
-> String
-> Int
-> String
-> Maybe [(String, Maybe Value)]
-> Double
-> [Datum]
-> TimeStamp
-> OSCTarget
OSCTarget {oName :: String
oName = "Dirt",
oAddress :: String
oAddress = "127.0.0.1",
oPort :: Int
oPort = 7771,
oPath :: String
oPath = "/play",
oShape :: Maybe [(String, Maybe Value)]
oShape = [(String, Maybe Value)] -> Maybe [(String, Maybe Value)]
forall a. a -> Maybe a
Just [("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)
],
oLatency :: Double
oLatency = 0.02,
oPreamble :: [Datum]
oPreamble = [],
oTimestamp :: TimeStamp
oTimestamp = TimeStamp
MessageStamp
}
startStream :: Config -> MVar StateMap -> [OSCTarget] -> IO (MVar ControlPattern, MVar T.Tempo, [Cx])
startStream :: Config
-> MVar StateMap
-> [OSCTarget]
-> IO (MVar ControlPattern, MVar Tempo, [Cx])
startStream config :: Config
config sMapMV :: MVar StateMap
sMapMV targets :: [OSCTarget]
targets
= do [Cx]
cxs <- (OSCTarget -> IO Cx) -> [OSCTarget] -> IO [Cx]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\target :: OSCTarget
target -> do UDP
u <- String -> Int -> IO UDP
O.openUDP (OSCTarget -> String
oAddress OSCTarget
target) (OSCTarget -> Int
oPort OSCTarget
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 :: OSCTarget -> UDP -> Cx
Cx {cxUDP :: UDP
cxUDP = UDP
u,
cxTarget :: OSCTarget
cxTarget = OSCTarget
target
}
) [OSCTarget]
targets
MVar ControlPattern
pMV <- ControlPattern -> IO (MVar ControlPattern)
forall a. a -> IO (MVar a)
newMVar ControlPattern
forall a. Pattern a
empty
(tempoMV :: MVar Tempo
tempoMV, _) <- Config
-> (MVar Tempo -> State -> IO ()) -> IO (MVar Tempo, [ThreadId])
T.clocked Config
config ((MVar Tempo -> State -> IO ()) -> IO (MVar Tempo, [ThreadId]))
-> (MVar Tempo -> State -> IO ()) -> IO (MVar Tempo, [ThreadId])
forall a b. (a -> b) -> a -> b
$ Config
-> MVar StateMap
-> MVar ControlPattern
-> [Cx]
-> MVar Tempo
-> State
-> IO ()
onTick Config
config MVar StateMap
sMapMV MVar ControlPattern
pMV [Cx]
cxs
(MVar ControlPattern, MVar Tempo, [Cx])
-> IO (MVar ControlPattern, MVar Tempo, [Cx])
forall (m :: * -> *) a. Monad m => a -> m a
return ((MVar ControlPattern, MVar Tempo, [Cx])
-> IO (MVar ControlPattern, MVar Tempo, [Cx]))
-> (MVar ControlPattern, MVar Tempo, [Cx])
-> IO (MVar ControlPattern, MVar Tempo, [Cx])
forall a b. (a -> b) -> a -> b
$ (MVar ControlPattern
pMV, MVar Tempo
tempoMV, [Cx]
cxs)
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
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 :: OSCTarget -> Event ControlMap -> Maybe [O.Datum]
toData :: OSCTarget -> Event ControlMap -> Maybe [Datum]
toData target :: OSCTarget
target e :: Event ControlMap
e
| Maybe [(String, Maybe Value)] -> Bool
forall a. Maybe a -> Bool
isJust (OSCTarget -> Maybe [(String, Maybe Value)]
oShape OSCTarget
target) = ([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) (Maybe [(String, Maybe Value)] -> [(String, Maybe Value)]
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe [(String, Maybe Value)] -> [(String, Maybe Value)])
-> Maybe [(String, Maybe Value)] -> [(String, Maybe Value)]
forall a b. (a -> b) -> a -> b
$ OSCTarget -> Maybe [(String, Maybe Value)]
oShape OSCTarget
target)
| Bool
otherwise = [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
substitutePath :: String -> ControlMap -> String
substitutePath :: String -> ControlMap -> String
substitutePath path :: String
path cm :: ControlMap
cm = ShowS
parse String
path
where parse :: ShowS
parse [] = []
parse ('{':xs :: String
xs) = ShowS
parseWord String
xs
parse (x :: Char
x:xs :: String
xs) = Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:(ShowS
parse String
xs)
parseWord :: ShowS
parseWord xs :: String
xs | String
b String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== [] = ControlMap -> ShowS
getString ControlMap
cm String
a
| Bool
otherwise = ControlMap -> ShowS
getString ControlMap
cm String
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
parse (ShowS
forall a. [a] -> [a]
tail String
b)
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 -> String
getString :: ControlMap -> ShowS
getString cm :: ControlMap
cm s :: String
s = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe "" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ do Value
v <- String -> ControlMap -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
s ControlMap
cm
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
$ Value -> String
simpleShow Value
v
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
toMessage :: Config -> Double -> OSCTarget -> T.Tempo -> Event (Map.Map String Value) -> Maybe O.Message
toMessage :: Config
-> Double
-> OSCTarget
-> Tempo
-> Event ControlMap
-> Maybe Message
toMessage config :: Config
config t :: Double
t target :: OSCTarget
target tempo :: Tempo
tempo e :: Event ControlMap
e = do [Datum]
vs <- OSCTarget -> Event ControlMap -> Maybe [Datum]
toData OSCTarget
target Event ControlMap
addExtra
Message -> Maybe Message
forall (m :: * -> *) a. Monad m => a -> m a
return (Message -> Maybe Message) -> Message -> Maybe Message
forall a b. (a -> b) -> a -> b
$ String -> [Datum] -> Message
O.Message (String -> ControlMap -> String
substitutePath (OSCTarget -> String
oPath OSCTarget
target) (Event ControlMap -> ControlMap
forall a b. EventF a b -> b
value Event ControlMap
e)) ([Datum] -> Message) -> [Datum] -> Message
forall a b. (a -> b) -> a -> b
$ OSCTarget -> [Datum]
oPreamble OSCTarget
target [Datum] -> [Datum] -> [Datum]
forall a. [a] -> [a] -> [a]
++ [Datum]
vs
where on :: Double
on = Tempo -> Rational -> Double
sched Tempo
tempo (Rational -> Double) -> Rational -> Double
forall a b. (a -> b) -> a -> b
$ ArcF Rational -> Rational
forall a. ArcF a -> a
start (ArcF Rational -> Rational) -> ArcF Rational -> Rational
forall a b. (a -> b) -> a -> b
$ Event ControlMap -> ArcF Rational
forall a. Event a -> ArcF Rational
wholeOrPart Event ControlMap
e
off :: Double
off = Tempo -> Rational -> Double
sched Tempo
tempo (Rational -> Double) -> Rational -> Double
forall a b. (a -> b) -> a -> b
$ ArcF Rational -> Rational
forall a. ArcF a -> a
stop (ArcF Rational -> Rational) -> ArcF Rational -> Rational
forall a b. (a -> b) -> a -> b
$ Event ControlMap -> ArcF Rational
forall a. Event a -> ArcF Rational
wholeOrPart Event ControlMap
e
cm :: ControlMap
cm = Event ControlMap -> ControlMap
forall a b. EventF a b -> b
value Event ControlMap
e
identifier :: String
identifier = ((if (ArcF Rational -> Rational
forall a. ArcF a -> a
start (ArcF Rational -> Rational) -> ArcF Rational -> Rational
forall a b. (a -> b) -> a -> b
$ Event ControlMap -> ArcF Rational
forall a. Event a -> ArcF Rational
wholeOrPart Event ControlMap
e) Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== (ArcF Rational -> Rational
forall a. ArcF a -> a
start (ArcF Rational -> Rational) -> ArcF Rational -> Rational
forall a b. (a -> b) -> a -> b
$ Event ControlMap -> ArcF Rational
forall a b. EventF a b -> a
part Event ControlMap
e) then "X" else ">")
String -> ShowS
forall a. [a] -> [a] -> [a]
++ Rational -> String
forall a. Show a => a -> String
show (ArcF Rational -> Rational
forall a. ArcF a -> a
start (ArcF Rational -> Rational) -> ArcF Rational -> Rational
forall a b. (a -> b) -> a -> b
$ Event ControlMap -> ArcF Rational
forall a. Event a -> ArcF Rational
wholeOrPart Event ControlMap
e)
String -> ShowS
forall a. [a] -> [a] -> [a]
++ "-"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ Rational -> String
forall a. Show a => a -> String
show (ArcF Rational -> Rational
forall a. ArcF a -> a
stop (ArcF Rational -> Rational) -> ArcF Rational -> Rational
forall a b. (a -> b) -> a -> b
$ Event ControlMap -> ArcF Rational
forall a. Event a -> ArcF Rational
wholeOrPart Event ControlMap
e)
String -> ShowS
forall a. [a] -> [a] -> [a]
++ "-"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ ControlMap -> ShowS
getString ControlMap
cm "n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ "-"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ ControlMap -> ShowS
getString ControlMap
cm "note"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ "-"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ ControlMap -> ShowS
getString ControlMap
cm "s"
)
delta :: Double
delta = Double
off Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
on
messageStamp :: Bool
messageStamp = OSCTarget -> TimeStamp
oTimestamp OSCTarget
target TimeStamp -> TimeStamp -> Bool
forall a. Eq a => a -> a -> Bool
== TimeStamp
MessageStamp
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 -> ControlMap) -> ControlMap -> ControlMap
forall a b. (a -> b) -> a -> b
$ [(String, Value)] -> ControlMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (Bool -> [(String, Value)]
extra Bool
messageStamp)
)) (ControlMap -> ControlMap) -> Event ControlMap -> Event ControlMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event ControlMap
e
addIdentifier :: [(String, Value)] -> [(String, Value)]
addIdentifier | Config -> Bool
cSendParts Config
config = (("id", String -> Value
VS String
identifier)(String, Value) -> [(String, Value)] -> [(String, Value)]
forall a. a -> [a] -> [a]
:)
| Bool
otherwise = [(String, Value)] -> [(String, Value)]
forall a. a -> a
id
extra :: Bool -> [(String, Value)]
extra False = [(String, Value)] -> [(String, Value)]
addIdentifier [("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
$ ArcF Rational -> Rational
forall a. ArcF a -> a
start (ArcF Rational -> Rational) -> ArcF Rational -> Rational
forall a b. (a -> b) -> a -> b
$ Event ControlMap -> ArcF Rational
forall a. Event a -> ArcF Rational
wholeOrPart Event ControlMap
e))
]
extra True = [(String, Value)]
timestamp [(String, Value)] -> [(String, Value)] -> [(String, Value)]
forall a. [a] -> [a] -> [a]
++ (Bool -> [(String, Value)]
extra Bool
False)
timestamp :: [(String, Value)]
timestamp = [("sec", Int -> Value
VI Int
sec),
("usec", Int -> Value
VI Int
usec)
]
ut :: Double
ut = Double -> Double
forall n. Num n => n -> n
O.ntpr_to_ut Double
t
sec :: Int
sec = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
ut
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))
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 :: Config -> MVar StateMap -> MVar ControlPattern -> [Cx] -> MVar T.Tempo -> T.State -> IO ()
onTick :: Config
-> MVar StateMap
-> MVar ControlPattern
-> [Cx]
-> MVar Tempo
-> State
-> IO ()
onTick config :: Config
config sMapMV :: MVar StateMap
sMapMV pMV :: MVar ControlPattern
pMV cxs :: [Cx]
cxs tempoMV :: MVar Tempo
tempoMV st :: State
st =
do ControlPattern
p <- MVar ControlPattern -> IO ControlPattern
forall a. MVar a -> IO a
readMVar MVar ControlPattern
pMV
StateMap
sMap <- MVar StateMap -> IO StateMap
forall a. MVar a -> IO a
readMVar MVar StateMap
sMapMV
Tempo
tempo <- MVar Tempo -> IO Tempo
forall a. MVar a -> IO a
takeMVar MVar Tempo
tempoMV
let 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
es :: [Event ControlMap]
es = (Event ControlMap -> Rational)
-> [Event ControlMap] -> [Event ControlMap]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (ArcF Rational -> Rational
forall a. ArcF a -> a
start (ArcF Rational -> Rational)
-> (Event ControlMap -> ArcF Rational)
-> Event ControlMap
-> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event ControlMap -> ArcF Rational
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
p (State :: ArcF Rational -> StateMap -> State
State {arc :: ArcF Rational
arc = State -> ArcF Rational
T.nowArc State
st, controls :: StateMap
controls = StateMap
sMap'})
filterOns :: [Event a] -> [Event a]
filterOns | Config -> Bool
cSendParts Config
config = [Event a] -> [Event a]
forall a. a -> a
id
| Bool
otherwise = (Event a -> Bool) -> [Event a] -> [Event a]
forall a. (a -> Bool) -> [a] -> [a]
filter Event a -> Bool
forall a. Event a -> Bool
eventHasOnset
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
$ ArcF Rational -> Rational
forall a. ArcF a -> a
start (ArcF Rational -> Rational) -> ArcF Rational -> Rational
forall a b. (a -> b) -> a -> b
$ Event a -> ArcF Rational
forall a. Event a -> ArcF Rational
wholeOrPart Event a
e)
eventNudge :: EventF a ControlMap -> Double
eventNudge e :: EventF a ControlMap
e = 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
$ EventF a ControlMap -> ControlMap
forall a b. EventF a b -> b
value EventF a ControlMap
e
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
latency :: OSCTarget -> Double
latency target :: OSCTarget
target = OSCTarget -> Double
oLatency OSCTarget
target Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Config -> Double
cFrameTimespan Config
config Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Tempo -> Double
T.nudged Tempo
tempo
(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 target :: OSCTarget
target udp :: UDP
udp) -> (do let ms :: [(Double, Message)]
ms = [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
$ ((Tempo, Event ControlMap) -> Maybe (Double, Message))
-> [(Tempo, Event ControlMap)] -> [Maybe (Double, Message)]
forall a b. (a -> b) -> [a] -> [b]
map (\(t :: Tempo
t, e :: Event ControlMap
e) -> do let nudge :: Double
nudge = Event ControlMap -> Double
forall a. EventF a ControlMap -> Double
eventNudge Event ControlMap
e
let onset :: Double
onset = Event ControlMap -> Tempo -> Double
forall a. Event a -> Tempo -> Double
on Event ControlMap
e Tempo
t
Message
m <- Config
-> Double
-> OSCTarget
-> Tempo
-> Event ControlMap
-> Maybe Message
toMessage Config
config (Double
onset Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
nudge Double -> Double -> Double
forall a. Num a => a -> a -> a
+ OSCTarget -> Double
latency OSCTarget
target) OSCTarget
target Tempo
tempo Event ControlMap
e
if (Double
onset Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
frameEnd)
then (Double, Message) -> Maybe (Double, Message)
forall a. a -> Maybe a
Just (Double
onset Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
nudge, Message
m)
else Maybe (Double, Message)
forall a. Maybe a
Nothing
) [(Tempo, Event ControlMap)]
tes
IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (((Double, Message) -> IO ()) -> [(Double, Message)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (OSCTarget -> Double -> UDP -> (Double, Message) -> IO ()
forall t.
Transport t =>
OSCTarget -> Double -> t -> (Double, Message) -> IO ()
send OSCTarget
target (OSCTarget -> Double
latency OSCTarget
target) UDP
udp) [(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]
++ OSCTarget -> String
oName OSCTarget
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 MVar Tempo
tempoMV Tempo
tempo'
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
send :: O.Transport t => OSCTarget -> Double -> t -> (Double, O.Message) -> IO ()
send :: OSCTarget -> Double -> t -> (Double, Message) -> IO ()
send target :: OSCTarget
target latency :: Double
latency u :: t
u (time :: Double
time, m :: Message
m)
| OSCTarget -> TimeStamp
oTimestamp OSCTarget
target TimeStamp -> TimeStamp -> Bool
forall a. Eq a => a -> a -> Bool
== TimeStamp
BundleStamp = t -> Bundle -> IO ()
forall t. Transport t => t -> Bundle -> IO ()
O.sendBundle t
u (Bundle -> IO ()) -> Bundle -> IO ()
forall a b. (a -> b) -> a -> b
$ Double -> [Message] -> Bundle
O.Bundle (Double
time Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
latency) [Message
m]
| OSCTarget -> TimeStamp
oTimestamp OSCTarget
target TimeStamp -> TimeStamp -> Bool
forall a. Eq a => a -> a -> Bool
== TimeStamp
MessageStamp = t -> Message -> IO ()
forall t. Transport t => t -> Message -> IO ()
O.sendMessage t
u 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
timeDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
latency) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
now) Double -> Double -> Double
forall a. Num a => a -> a -> a
* 1000000
t -> Message -> IO ()
forall t. Transport t => t -> Message -> IO ()
O.sendMessage t
u Message
m
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
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 _ _ 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 _ 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 -> ArcF Rational -> [Event ControlMap]
forall a. Pattern a -> ArcF Rational -> [Event a]
queryArc ControlPattern
pat (Rational -> Rational -> ArcF Rational
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
Stream -> IO ()
calcOutput Stream
s
() -> 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})
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 st :: Stream
st p :: ControlPattern
p
= do StateMap
sMap <- MVar StateMap -> IO StateMap
forall a. MVar a -> IO a
readMVar (Stream -> MVar StateMap
sInput Stream
st)
Tempo
tempo <- MVar Tempo -> IO Tempo
forall a. MVar a -> IO a
readMVar (Stream -> MVar Tempo
sTempoMV Stream
st)
Double
now <- IO Double
forall (m :: * -> *). MonadIO m => m Double
O.time
let fakeTempo :: Tempo
fakeTempo = Tempo :: Double
-> Rational
-> Double
-> Bool
-> Double
-> UDP
-> SockAddr
-> Bool
-> Tempo
T.Tempo {cps :: Double
T.cps = Tempo -> Double
T.cps Tempo
tempo,
atCycle :: Rational
T.atCycle = 0,
atTime :: Double
T.atTime = Double
now,
paused :: Bool
T.paused = Bool
False,
nudged :: Double
T.nudged = 0
}
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
es :: [Event ControlMap]
es = (Event ControlMap -> Bool)
-> [Event ControlMap] -> [Event ControlMap]
forall a. (a -> Bool) -> [a] -> [a]
filter Event ControlMap -> Bool
forall a. Event a -> Bool
eventHasOnset ([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
p (State :: ArcF Rational -> StateMap -> State
State {arc :: ArcF Rational
arc = (Rational -> Rational -> ArcF Rational
forall a. a -> a -> ArcF a
Arc 0 1),
controls :: StateMap
controls = StateMap
sMap'
}
)
at :: Event a -> Double
at e :: Event a
e = Tempo -> Rational -> Double
sched Tempo
fakeTempo (Rational -> Double) -> Rational -> Double
forall a b. (a -> b) -> a -> b
$ ArcF Rational -> Rational
forall a. ArcF a -> a
start (ArcF Rational -> Rational) -> ArcF Rational -> Rational
forall a b. (a -> b) -> a -> b
$ Event a -> ArcF Rational
forall a. Event a -> ArcF Rational
wholeOrPart Event a
e
on :: Event a -> Double
on e :: Event a
e = Tempo -> Rational -> Double
sched Tempo
tempo (Rational -> Double) -> Rational -> Double
forall a b. (a -> b) -> a -> b
$ ArcF Rational -> Rational
forall a. ArcF a -> a
start (ArcF Rational -> Rational) -> ArcF Rational -> Rational
forall a b. (a -> b) -> a -> b
$ Event a -> ArcF Rational
forall a. Event a -> ArcF Rational
wholeOrPart Event a
e
cpsChanges :: [(Double, Maybe Value)]
cpsChanges = (Event ControlMap -> (Double, Maybe Value))
-> [Event ControlMap] -> [(Double, Maybe Value)]
forall a b. (a -> b) -> [a] -> [b]
map (\e :: Event ControlMap
e -> (Event ControlMap -> Double
forall a. Event a -> Double
on Event ControlMap
e Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
now, 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)) [Event ControlMap]
es
config :: Config
config = Stream -> Config
sConfig Stream
st
messages :: OSCTarget -> [(Double, Message)]
messages target :: OSCTarget
target =
[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
$ (Event ControlMap -> Maybe (Double, Message))
-> [Event ControlMap] -> [Maybe (Double, Message)]
forall a b. (a -> b) -> [a] -> [b]
map (\e :: Event ControlMap
e -> do Message
m <- Config
-> Double
-> OSCTarget
-> Tempo
-> Event ControlMap
-> Maybe Message
toMessage Config
config (Event ControlMap -> Double
forall a. Event a -> Double
at Event ControlMap
e Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (OSCTarget -> Double
oLatency OSCTarget
target)) OSCTarget
target Tempo
fakeTempo Event ControlMap
e
(Double, Message) -> Maybe (Double, Message)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Double, Message) -> Maybe (Double, Message))
-> (Double, Message) -> Maybe (Double, Message)
forall a b. (a -> b) -> a -> b
$ (Event ControlMap -> Double
forall a. Event a -> Double
at Event ControlMap
e, Message
m)
) [Event ControlMap]
es
(Cx -> IO ()) -> [Cx] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Cx target :: OSCTarget
target udp :: UDP
udp) ->
IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (((Double, Message) -> IO ()) -> [(Double, Message)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (OSCTarget -> Double -> UDP -> (Double, Message) -> IO ()
forall t.
Transport t =>
OSCTarget -> Double -> t -> (Double, Message) -> IO ()
send OSCTarget
target (OSCTarget -> Double
oLatency OSCTarget
target) UDP
udp) (OSCTarget -> [(Double, Message)]
messages OSCTarget
target))
(\(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]
++ OSCTarget -> String
oName OSCTarget
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
)
) (Stream -> [Cx]
sCxs Stream
st)
((Double, Maybe Value) -> IO ())
-> [(Double, Maybe Value)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (MVar Tempo -> (Double, Maybe Value) -> IO ()
doCps (MVar Tempo -> (Double, Maybe Value) -> IO ())
-> MVar Tempo -> (Double, Maybe Value) -> IO ()
forall a b. (a -> b) -> a -> b
$ Stream -> MVar Tempo
sTempoMV Stream
st) [(Double, Maybe Value)]
cpsChanges
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
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'
Stream -> IO ()
calcOutput Stream
s
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
streamMuteAll :: Stream -> IO ()
streamMuteAll :: Stream -> IO ()
streamMuteAll s :: Stream
s = do MVar ControlPattern
-> (ControlPattern -> IO ControlPattern) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (Stream -> MVar ControlPattern
sOutput Stream
s) ((ControlPattern -> IO ControlPattern) -> IO ())
-> (ControlPattern -> IO ControlPattern) -> IO ()
forall a b. (a -> b) -> a -> b
$ ControlPattern -> IO ControlPattern
forall (m :: * -> *) a. Monad m => a -> m a
return (ControlPattern -> IO ControlPattern)
-> (ControlPattern -> ControlPattern)
-> ControlPattern
-> IO ControlPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ControlPattern -> ControlPattern -> ControlPattern
forall a b. a -> b -> a
const ControlPattern
forall a. Pattern a
silence
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 = do MVar ControlPattern
-> (ControlPattern -> IO ControlPattern) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (Stream -> MVar ControlPattern
sOutput Stream
s) ((ControlPattern -> IO ControlPattern) -> IO ())
-> (ControlPattern -> IO ControlPattern) -> IO ()
forall a b. (a -> b) -> a -> b
$ ControlPattern -> IO ControlPattern
forall (m :: * -> *) a. Monad m => a -> m a
return (ControlPattern -> IO ControlPattern)
-> (ControlPattern -> ControlPattern)
-> ControlPattern
-> IO ControlPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ControlPattern -> ControlPattern -> ControlPattern
forall a b. a -> b -> a
const ControlPattern
forall a. Pattern a
silence
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 = do 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})
Stream -> IO ()
calcOutput Stream
s
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
Stream -> IO ()
calcOutput Stream
s
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
calcOutput :: Stream -> IO ()
calcOutput :: Stream -> IO ()
calcOutput s :: Stream
s = do PlayMap
pMap <- MVar PlayMap -> IO PlayMap
forall a. MVar a -> IO a
readMVar (MVar PlayMap -> IO PlayMap) -> MVar PlayMap -> IO PlayMap
forall a b. (a -> b) -> a -> b
$ Stream -> MVar PlayMap
sPMapMV Stream
s
ControlPattern -> ControlPattern
globalF <- (MVar (ControlPattern -> ControlPattern)
-> IO (ControlPattern -> ControlPattern)
forall a. MVar a -> IO a
readMVar (MVar (ControlPattern -> ControlPattern)
-> IO (ControlPattern -> ControlPattern))
-> MVar (ControlPattern -> ControlPattern)
-> IO (ControlPattern -> ControlPattern)
forall a b. (a -> b) -> a -> b
$ Stream -> MVar (ControlPattern -> ControlPattern)
sGlobalFMV Stream
s)
ControlPattern
_ <- MVar ControlPattern -> ControlPattern -> IO ControlPattern
forall a. MVar a -> a -> IO a
swapMVar (Stream -> MVar ControlPattern
sOutput Stream
s) (ControlPattern -> IO ControlPattern)
-> ControlPattern -> IO ControlPattern
forall a b. (a -> b) -> a -> b
$ ControlPattern -> ControlPattern
globalF (ControlPattern -> ControlPattern)
-> ControlPattern -> ControlPattern
forall a b. (a -> b) -> a -> b
$ PlayMap -> ControlPattern
forall k. Map k PlayState -> ControlPattern
toPat (PlayMap -> ControlPattern) -> PlayMap -> ControlPattern
forall a b. (a -> b) -> a -> b
$ PlayMap
pMap
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where toPat :: Map k PlayState -> ControlPattern
toPat pMap :: Map k PlayState
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] -> [ControlPattern])
-> [PlayState] -> [ControlPattern]
forall a b. (a -> b) -> a -> b
$ (PlayState -> Bool) -> [PlayState] -> [PlayState]
forall a. (a -> Bool) -> [a] -> [a]
filter (\pState :: PlayState
pState -> if Map k PlayState -> Bool
forall k. Map k PlayState -> Bool
hasSolo Map k PlayState
pMap
then PlayState -> Bool
solo PlayState
pState
else Bool -> Bool
not (PlayState -> Bool
mute PlayState
pState)
) (Map k PlayState -> [PlayState]
forall k a. Map k a -> [a]
Map.elems Map k PlayState
pMap)
startTidal :: OSCTarget -> Config -> IO Stream
startTidal :: OSCTarget -> Config -> IO Stream
startTidal target :: OSCTarget
target config :: Config
config = [OSCTarget] -> Config -> IO Stream
startMulti [OSCTarget
target] Config
config
startMulti :: [OSCTarget] -> Config -> IO Stream
startMulti :: [OSCTarget] -> Config -> IO Stream
startMulti targets :: [OSCTarget]
targets config :: Config
config =
do MVar StateMap
sMapMV <- StateMap -> IO (MVar StateMap)
forall a. a -> IO (MVar a)
newMVar (StateMap
forall k a. Map k a
Map.empty :: StateMap)
Maybe ThreadId
listenTid <- MVar StateMap -> Config -> IO (Maybe ThreadId)
ctrlListen MVar StateMap
sMapMV Config
config
(pMV :: MVar ControlPattern
pMV, tempoMV :: MVar Tempo
tempoMV, cxs :: [Cx]
cxs) <- Config
-> MVar StateMap
-> [OSCTarget]
-> IO (MVar ControlPattern, MVar Tempo, [Cx])
startStream Config
config MVar StateMap
sMapMV [OSCTarget]
targets
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
Stream -> IO Stream
forall (m :: * -> *) a. Monad m => a -> m a
return (Stream -> IO Stream) -> Stream -> IO Stream
forall a b. (a -> b) -> a -> b
$ Stream :: Config
-> MVar StateMap
-> MVar ControlPattern
-> 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,
sOutput :: MVar ControlPattern
sOutput = MVar ControlPattern
pMV,
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
}
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