{-# 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 Control.Monad.Reader
-- import Control.Monad.Except
-- import qualified Data.Bifunctor as BF
-- import qualified Data.Bool as B
-- import qualified Data.Char as C
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 qualified Sound.OSC.Datum as O
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
        -- If there is already cps in the event, the union will preserve that.
        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
                                                       -- hack to stop things from stopping !
                                                       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
           -- there should always be a whole (due to the eventHasOnset filter)
         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)
         -- If an event has a tempo change, that affects the following
         -- events..
         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
                                                                            -- drop events that have gone out of frame (due to tempo
                                                                            -- changes during the frame)
                                                                            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)

-- Interaction

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"

-- Evaluation of pat is forced so exceptions are picked up here, before replacing the existing pattern.
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
                -- put change time in control input
                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
                -- update the pattern itself
                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'
                                                      }
                                               )
           -- there should always be a whole (due to the eventHasOnset filter)
           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
           -- there should always be a whole (due to the eventHasOnset filter)
           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 ()

-- TODO - is there a race condition here?
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