{-# LANGUAGE ConstraintKinds, GeneralizedNewtypeDeriving, FlexibleContexts, ScopedTypeVariables, BangPatterns #-}
{-# OPTIONS_GHC -fno-warn-missing-fields #-}
{-# language DeriveGeneric, StandaloneDeriving #-}

module Sound.Tidal.Stream where

{-
    Stream.hs - Tidal's thingie for turning patterns into OSC streams
    Copyright (C) 2020, Alex McLean and contributors

    This library is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this library.  If not, see <http://www.gnu.org/licenses/>.
-}

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

import qualified Sound.OSC.FD as O
import qualified Network.Socket          as N

import           Sound.Tidal.Config
import           Sound.Tidal.Core (stack, silence)
import           Sound.Tidal.Pattern
import qualified Sound.Tidal.Tempo as T
import           Sound.Tidal.Utils ((!!!))
-- import qualified Sound.OSC.Datum as O
import           Data.List (sortOn)
import           System.Random (getStdRandom, randomR)
import           Sound.Tidal.Show ()
import           Data.Word (Word8)

import           Sound.Tidal.Version

data Stream = Stream {Stream -> Config
sConfig :: Config,
                      Stream -> MVar [Int]
sBusses :: MVar [Int],
                      Stream -> MVar ValueMap
sStateMV :: MVar ValueMap,
                      -- sOutput :: MVar ControlPattern,
                      Stream -> Maybe UDP
sListen :: Maybe O.UDP,
                      Stream -> MVar PlayMap
sPMapMV :: MVar PlayMap,
                      Stream -> MVar Tempo
sTempoMV :: MVar T.Tempo,
                      Stream -> MVar (ControlPattern -> ControlPattern)
sGlobalFMV :: MVar (ControlPattern -> ControlPattern),
                      Stream -> [Cx]
sCxs :: [Cx]
                     }

type PatId = String

data Cx = Cx {Cx -> Target
cxTarget :: Target,
              Cx -> UDP
cxUDP :: O.UDP,
              Cx -> [OSC]
cxOSCs :: [OSC],
              Cx -> AddrInfo
cxAddr :: N.AddrInfo,
              Cx -> Maybe AddrInfo
cxBusAddr :: Maybe N.AddrInfo
             }
  deriving (Int -> Cx -> ShowS
[Cx] -> ShowS
Cx -> String
(Int -> Cx -> ShowS)
-> (Cx -> String) -> ([Cx] -> ShowS) -> Show Cx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cx] -> ShowS
$cshowList :: [Cx] -> ShowS
show :: Cx -> String
$cshow :: Cx -> String
showsPrec :: Int -> Cx -> ShowS
$cshowsPrec :: Int -> Cx -> ShowS
Show)

data StampStyle = BundleStamp
                | MessageStamp
  deriving (StampStyle -> StampStyle -> Bool
(StampStyle -> StampStyle -> Bool)
-> (StampStyle -> StampStyle -> Bool) -> Eq StampStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StampStyle -> StampStyle -> Bool
$c/= :: StampStyle -> StampStyle -> Bool
== :: StampStyle -> StampStyle -> Bool
$c== :: StampStyle -> StampStyle -> Bool
Eq, Int -> StampStyle -> ShowS
[StampStyle] -> ShowS
StampStyle -> String
(Int -> StampStyle -> ShowS)
-> (StampStyle -> String)
-> ([StampStyle] -> ShowS)
-> Show StampStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StampStyle] -> ShowS
$cshowList :: [StampStyle] -> ShowS
show :: StampStyle -> String
$cshow :: StampStyle -> String
showsPrec :: Int -> StampStyle -> ShowS
$cshowsPrec :: Int -> StampStyle -> ShowS
Show)

data Schedule = Pre StampStyle
              | Live
  deriving (Schedule -> Schedule -> Bool
(Schedule -> Schedule -> Bool)
-> (Schedule -> Schedule -> Bool) -> Eq Schedule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Schedule -> Schedule -> Bool
$c/= :: Schedule -> Schedule -> Bool
== :: Schedule -> Schedule -> Bool
$c== :: Schedule -> Schedule -> Bool
Eq, Int -> Schedule -> ShowS
[Schedule] -> ShowS
Schedule -> String
(Int -> Schedule -> ShowS)
-> (Schedule -> String) -> ([Schedule] -> ShowS) -> Show Schedule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Schedule] -> ShowS
$cshowList :: [Schedule] -> ShowS
show :: Schedule -> String
$cshow :: Schedule -> String
showsPrec :: Int -> Schedule -> ShowS
$cshowsPrec :: Int -> Schedule -> ShowS
Show)

data Target = Target {Target -> String
oName :: String,
                      Target -> String
oAddress :: String,
                      Target -> Int
oPort :: Int,
                      Target -> Maybe Int
oBusPort :: Maybe Int,
                      Target -> Double
oLatency :: Double,
                      Target -> Maybe Arc
oWindow :: Maybe Arc,
                      Target -> Schedule
oSchedule :: Schedule,
                      Target -> Bool
oHandshake :: Bool
                     }
                 deriving Int -> Target -> ShowS
[Target] -> ShowS
Target -> String
(Int -> Target -> ShowS)
-> (Target -> String) -> ([Target] -> ShowS) -> Show Target
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Target] -> ShowS
$cshowList :: [Target] -> ShowS
show :: Target -> String
$cshow :: Target -> String
showsPrec :: Int -> Target -> ShowS
$cshowsPrec :: Int -> Target -> ShowS
Show

data Args = Named {Args -> [String]
requiredArgs :: [String]}
          | ArgList [(String, Maybe Value)]
         deriving Int -> Args -> ShowS
[Args] -> ShowS
Args -> String
(Int -> Args -> ShowS)
-> (Args -> String) -> ([Args] -> ShowS) -> Show Args
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Args] -> ShowS
$cshowList :: [Args] -> ShowS
show :: Args -> String
$cshow :: Args -> String
showsPrec :: Int -> Args -> ShowS
$cshowsPrec :: Int -> Args -> ShowS
Show

data OSC = OSC {OSC -> String
path :: String,
                OSC -> Args
args :: Args
               }
         | OSCContext {path :: String}
         deriving Int -> OSC -> ShowS
[OSC] -> ShowS
OSC -> String
(Int -> OSC -> ShowS)
-> (OSC -> String) -> ([OSC] -> ShowS) -> Show OSC
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OSC] -> ShowS
$cshowList :: [OSC] -> ShowS
show :: OSC -> String
$cshow :: OSC -> String
showsPrec :: Int -> OSC -> ShowS
$cshowsPrec :: Int -> OSC -> ShowS
Show

data PlayState = PlayState {PlayState -> ControlPattern
pattern :: ControlPattern,
                            PlayState -> Bool
mute :: Bool,
                            PlayState -> Bool
solo :: Bool,
                            PlayState -> [ControlPattern]
history :: [ControlPattern]
                           }
               deriving Int -> PlayState -> ShowS
[PlayState] -> ShowS
PlayState -> String
(Int -> PlayState -> ShowS)
-> (PlayState -> String)
-> ([PlayState] -> ShowS)
-> Show PlayState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlayState] -> ShowS
$cshowList :: [PlayState] -> ShowS
show :: PlayState -> String
$cshow :: PlayState -> String
showsPrec :: Int -> PlayState -> ShowS
$cshowsPrec :: Int -> PlayState -> ShowS
Show

type PlayMap = Map.Map PatId PlayState


sDefault :: String -> Maybe Value
sDefault :: String -> Maybe Value
sDefault String
x = 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 String
x
fDefault :: Double -> Maybe Value
fDefault :: Double -> Maybe Value
fDefault Double
x = 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 Double
x
rDefault :: Rational -> Maybe Value
rDefault :: Rational -> Maybe Value
rDefault Rational
x = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Rational -> Value
VR Rational
x
iDefault :: Int -> Maybe Value
iDefault :: Int -> Maybe Value
iDefault Int
x = 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 Int
x
bDefault :: Bool -> Maybe Value
bDefault :: Bool -> Maybe Value
bDefault Bool
x = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Bool -> Value
VB Bool
x
xDefault :: [Word8] -> Maybe Value
xDefault :: [Word8] -> Maybe Value
xDefault [Word8]
x = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ [Word8] -> Value
VX [Word8]
x

required :: Maybe Value
required :: Maybe Value
required = Maybe Value
forall a. Maybe a
Nothing

superdirtTarget :: Target
superdirtTarget :: Target
superdirtTarget = Target :: String
-> String
-> Int
-> Maybe Int
-> Double
-> Maybe Arc
-> Schedule
-> Bool
-> Target
Target {oName :: String
oName = String
"SuperDirt",
                          oAddress :: String
oAddress = String
"127.0.0.1",
                          oPort :: Int
oPort = Int
57120,
                          oBusPort :: Maybe Int
oBusPort = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
57110,
                          oLatency :: Double
oLatency = Double
0.2,
                          oWindow :: Maybe Arc
oWindow = Maybe Arc
forall a. Maybe a
Nothing,
                          oSchedule :: Schedule
oSchedule = StampStyle -> Schedule
Pre StampStyle
BundleStamp,
                          oHandshake :: Bool
oHandshake = Bool
True
                         }

superdirtShape :: OSC
superdirtShape :: OSC
superdirtShape = String -> Args -> OSC
OSC String
"/dirt/play" (Args -> OSC) -> Args -> OSC
forall a b. (a -> b) -> a -> b
$ Named :: [String] -> Args
Named {requiredArgs :: [String]
requiredArgs = [String
"s"]}

dirtTarget :: Target
dirtTarget :: Target
dirtTarget = Target :: String
-> String
-> Int
-> Maybe Int
-> Double
-> Maybe Arc
-> Schedule
-> Bool
-> Target
Target {oName :: String
oName = String
"Dirt",
                     oAddress :: String
oAddress = String
"127.0.0.1",
                     oPort :: Int
oPort = Int
7771,
                     oBusPort :: Maybe Int
oBusPort = Maybe Int
forall a. Maybe a
Nothing,
                     oLatency :: Double
oLatency = Double
0.02,
                     oWindow :: Maybe Arc
oWindow = Maybe Arc
forall a. Maybe a
Nothing,
                     oSchedule :: Schedule
oSchedule = StampStyle -> Schedule
Pre StampStyle
MessageStamp,
                     oHandshake :: Bool
oHandshake = Bool
False
                    }

dirtShape :: OSC
dirtShape :: OSC
dirtShape = String -> Args -> OSC
OSC String
"/play" (Args -> OSC) -> Args -> OSC
forall a b. (a -> b) -> a -> b
$ [(String, Maybe Value)] -> Args
ArgList [(String
"sec", Int -> Maybe Value
iDefault Int
0),
                                   (String
"usec", Int -> Maybe Value
iDefault Int
0),
                                   (String
"cps", Double -> Maybe Value
fDefault Double
0),
                                   (String
"s", Maybe Value
required),
                                   (String
"offset", Double -> Maybe Value
fDefault Double
0),
                                   (String
"begin", Double -> Maybe Value
fDefault Double
0),
                                   (String
"end", Double -> Maybe Value
fDefault Double
1),
                                   (String
"speed", Double -> Maybe Value
fDefault Double
1),
                                   (String
"pan", Double -> Maybe Value
fDefault Double
0.5),
                                   (String
"velocity", Double -> Maybe Value
fDefault Double
0.5),
                                   (String
"vowel", String -> Maybe Value
sDefault String
""),
                                   (String
"cutoff", Double -> Maybe Value
fDefault Double
0),
                                   (String
"resonance", Double -> Maybe Value
fDefault Double
0),
                                   (String
"accelerate", Double -> Maybe Value
fDefault Double
0),
                                   (String
"shape", Double -> Maybe Value
fDefault Double
0),
                                   (String
"kriole", Int -> Maybe Value
iDefault Int
0),
                                   (String
"gain", Double -> Maybe Value
fDefault Double
1),
                                   (String
"cut", Int -> Maybe Value
iDefault Int
0),
                                   (String
"delay", Double -> Maybe Value
fDefault Double
0),
                                   (String
"delaytime", Double -> Maybe Value
fDefault (-Double
1)),
                                   (String
"delayfeedback", Double -> Maybe Value
fDefault (-Double
1)),
                                   (String
"crush", Double -> Maybe Value
fDefault Double
0),
                                   (String
"coarse", Int -> Maybe Value
iDefault Int
0),
                                   (String
"hcutoff", Double -> Maybe Value
fDefault Double
0),
                                   (String
"hresonance", Double -> Maybe Value
fDefault Double
0),
                                   (String
"bandf", Double -> Maybe Value
fDefault Double
0),
                                   (String
"bandq", Double -> Maybe Value
fDefault Double
0),
                                   (String
"unit", String -> Maybe Value
sDefault String
"rate"),
                                   (String
"loop", Double -> Maybe Value
fDefault Double
0),
                                   (String
"n", Double -> Maybe Value
fDefault Double
0),
                                   (String
"attack", Double -> Maybe Value
fDefault (-Double
1)),
                                   (String
"hold", Double -> Maybe Value
fDefault Double
0),
                                   (String
"release", Double -> Maybe Value
fDefault (-Double
1)),
                                   (String
"orbit", Int -> Maybe Value
iDefault Int
0),
                                   (String
"id", Int -> Maybe Value
iDefault Int
0)
                                  ]

startStream :: Config -> [(Target, [OSC])] -> IO Stream
startStream :: Config -> [(Target, [OSC])] -> IO Stream
startStream Config
config [(Target, [OSC])]
oscmap 
  = do MVar ValueMap
sMapMV <- ValueMap -> IO (MVar ValueMap)
forall a. a -> IO (MVar a)
newMVar ValueMap
forall k a. Map k a
Map.empty
       MVar PlayMap
pMapMV <- PlayMap -> IO (MVar PlayMap)
forall a. a -> IO (MVar a)
newMVar PlayMap
forall k a. Map k a
Map.empty
       MVar [Int]
bussesMV <- [Int] -> IO (MVar [Int])
forall a. a -> IO (MVar a)
newMVar []
       MVar (ControlPattern -> ControlPattern)
globalFMV <- (ControlPattern -> ControlPattern)
-> IO (MVar (ControlPattern -> ControlPattern))
forall a. a -> IO (MVar a)
newMVar ControlPattern -> ControlPattern
forall a. a -> a
id
       MVar Tempo
tempoMV <- IO (MVar Tempo)
forall a. IO (MVar a)
newEmptyMVar

       IO String
tidal_status_string IO String -> (String -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Config -> String -> IO ()
verbose Config
config
       Config -> String -> IO ()
verbose Config
config (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Listening for external controls on " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Config -> String
cCtrlAddr Config
config String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Config -> Int
cCtrlPort Config
config)
       Maybe UDP
listen <- Config -> IO (Maybe UDP)
openListener Config
config

       [Cx]
cxs <- ((Target, [OSC]) -> IO Cx) -> [(Target, [OSC])] -> IO [Cx]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(Target
target, [OSC]
os) -> do AddrInfo
remote_addr <- String -> String -> IO AddrInfo
resolve (Target -> String
oAddress Target
target) (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Target -> Int
oPort Target
target)
                                        Maybe AddrInfo
remote_bus_addr <- if Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Int -> Bool) -> Maybe Int -> Bool
forall a b. (a -> b) -> a -> b
$ Target -> Maybe Int
oBusPort Target
target
                                                           then AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just (AddrInfo -> Maybe AddrInfo) -> IO AddrInfo -> IO (Maybe AddrInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> IO AddrInfo
resolve (Target -> String
oAddress Target
target) (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Target -> Maybe Int
oBusPort Target
target)
                                                           else Maybe AddrInfo -> IO (Maybe AddrInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AddrInfo
forall a. Maybe a
Nothing
                                        UDP
u <- String -> Int -> IO UDP
O.openUDP (Target -> String
oAddress Target
target) (Target -> Int
oPort Target
target)
                                        Cx -> IO Cx
forall (m :: * -> *) a. Monad m => a -> m a
return (Cx -> IO Cx) -> Cx -> IO Cx
forall a b. (a -> b) -> a -> b
$ Cx :: Target -> UDP -> [OSC] -> AddrInfo -> Maybe AddrInfo -> Cx
Cx {cxUDP :: UDP
cxUDP = UDP
u, cxAddr :: AddrInfo
cxAddr = AddrInfo
remote_addr, cxBusAddr :: Maybe AddrInfo
cxBusAddr = Maybe AddrInfo
remote_bus_addr, cxTarget :: Target
cxTarget = Target
target, cxOSCs :: [OSC]
cxOSCs = [OSC]
os}                                        
                   ) [(Target, [OSC])]
oscmap
       let stream :: Stream
stream = Stream :: Config
-> MVar [Int]
-> MVar ValueMap
-> Maybe UDP
-> MVar PlayMap
-> MVar Tempo
-> MVar (ControlPattern -> ControlPattern)
-> [Cx]
-> Stream
Stream {sConfig :: Config
sConfig = Config
config,
                            sBusses :: MVar [Int]
sBusses = MVar [Int]
bussesMV,
                            sStateMV :: MVar ValueMap
sStateMV  = MVar ValueMap
sMapMV,
                            sListen :: Maybe UDP
sListen = Maybe UDP
listen,
                            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
                           }
       Stream -> IO ()
sendHandshakes Stream
stream
       [ThreadId]
_ <- Config -> MVar Tempo -> (State -> IO ()) -> IO [ThreadId]
T.clocked Config
config MVar Tempo
tempoMV ((State -> IO ()) -> IO [ThreadId])
-> (State -> IO ()) -> IO [ThreadId]
forall a b. (a -> b) -> a -> b
$ Stream -> State -> IO ()
onTick Stream
stream
       ThreadId
_ <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Int -> Config -> Stream -> IO ()
ctrlResponder Int
0 Config
config Stream
stream
       Stream -> IO Stream
forall (m :: * -> *) a. Monad m => a -> m a
return Stream
stream

-- It only really works to handshake with one target at the moment..
sendHandshakes :: Stream -> IO ()
sendHandshakes :: Stream -> IO ()
sendHandshakes Stream
stream = (Cx -> IO ()) -> [Cx] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Cx -> IO ()
sendHandshake ([Cx] -> IO ()) -> [Cx] -> IO ()
forall a b. (a -> b) -> a -> b
$ (Cx -> Bool) -> [Cx] -> [Cx]
forall a. (a -> Bool) -> [a] -> [a]
filter (Target -> Bool
oHandshake (Target -> Bool) -> (Cx -> Target) -> Cx -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cx -> Target
cxTarget) (Stream -> [Cx]
sCxs Stream
stream)
  where sendHandshake :: Cx -> IO ()
sendHandshake Cx
cx = if (Maybe UDP -> Bool
forall a. Maybe a -> Bool
isJust (Maybe UDP -> Bool) -> Maybe UDP -> Bool
forall a b. (a -> b) -> a -> b
$ Stream -> Maybe UDP
sListen Stream
stream)
                           then                                            
                             do -- send it _from_ the udp socket we're listening to, so the
                                -- replies go back there
                                Bool -> Maybe UDP -> Cx -> Message -> IO ()
sendO Bool
False (Stream -> Maybe UDP
sListen Stream
stream) Cx
cx (Message -> IO ()) -> Message -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> [Datum] -> Message
O.Message String
"/dirt/handshake" []
                           else
                             Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"Can't handshake with SuperCollider without control port."

sendO :: Bool -> (Maybe O.UDP) -> Cx -> O.Message -> IO ()
sendO :: Bool -> Maybe UDP -> Cx -> Message -> IO ()
sendO Bool
isBusMsg (Just UDP
listen) Cx
cx Message
msg = UDP -> Packet -> SockAddr -> IO ()
O.sendTo UDP
listen (Message -> Packet
O.Packet_Message Message
msg) (AddrInfo -> SockAddr
N.addrAddress AddrInfo
addr)
  where addr :: AddrInfo
addr | Bool
isBusMsg Bool -> Bool -> Bool
&& Maybe AddrInfo -> Bool
forall a. Maybe a -> Bool
isJust (Cx -> Maybe AddrInfo
cxBusAddr Cx
cx) = Maybe AddrInfo -> AddrInfo
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe AddrInfo -> AddrInfo) -> Maybe AddrInfo -> AddrInfo
forall a b. (a -> b) -> a -> b
$ Cx -> Maybe AddrInfo
cxBusAddr Cx
cx
             | Bool
otherwise = Cx -> AddrInfo
cxAddr Cx
cx
sendO Bool
_ Maybe UDP
Nothing Cx
cx Message
msg = UDP -> Message -> IO ()
forall t. Transport t => t -> Message -> IO ()
O.sendMessage (Cx -> UDP
cxUDP Cx
cx) Message
msg

sendBndl :: Bool -> (Maybe O.UDP) -> Cx -> O.Bundle -> IO ()
sendBndl :: Bool -> Maybe UDP -> Cx -> Bundle -> IO ()
sendBndl Bool
isBusMsg (Just UDP
listen) Cx
cx Bundle
bndl = UDP -> Packet -> SockAddr -> IO ()
O.sendTo UDP
listen (Bundle -> Packet
O.Packet_Bundle Bundle
bndl) (AddrInfo -> SockAddr
N.addrAddress AddrInfo
addr)
  where addr :: AddrInfo
addr | Bool
isBusMsg Bool -> Bool -> Bool
&& Maybe AddrInfo -> Bool
forall a. Maybe a -> Bool
isJust (Cx -> Maybe AddrInfo
cxBusAddr Cx
cx) = Maybe AddrInfo -> AddrInfo
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe AddrInfo -> AddrInfo) -> Maybe AddrInfo -> AddrInfo
forall a b. (a -> b) -> a -> b
$ Cx -> Maybe AddrInfo
cxBusAddr Cx
cx
             | Bool
otherwise = Cx -> AddrInfo
cxAddr Cx
cx
sendBndl Bool
_ Maybe UDP
Nothing Cx
cx Bundle
bndl = UDP -> Bundle -> IO ()
forall t. Transport t => t -> Bundle -> IO ()
O.sendBundle (Cx -> UDP
cxUDP Cx
cx) Bundle
bndl

resolve :: String -> String -> IO N.AddrInfo
resolve :: String -> String -> IO AddrInfo
resolve String
host String
port = do let hints :: AddrInfo
hints = AddrInfo
N.defaultHints { addrSocketType :: SocketType
N.addrSocketType = SocketType
N.Stream }
                       AddrInfo
addr:[AddrInfo]
_ <- Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
N.getAddrInfo (AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just AddrInfo
hints) (String -> Maybe String
forall a. a -> Maybe a
Just String
host) (String -> Maybe String
forall a. a -> Maybe a
Just String
port)
                       AddrInfo -> IO AddrInfo
forall (m :: * -> *) a. Monad m => a -> m a
return AddrInfo
addr

startTidal :: Target -> Config -> IO Stream
startTidal :: Target -> Config -> IO Stream
startTidal Target
target Config
config = Config -> [(Target, [OSC])] -> IO Stream
startStream Config
config [(Target
target, [OSC
superdirtShape])]

startMulti :: [Target] -> Config -> IO ()
startMulti :: [Target] -> Config -> IO ()
startMulti [Target]
_ Config
_ = Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"startMulti has been removed, please check the latest documentation on tidalcycles.org"

toDatum :: Value -> O.Datum
toDatum :: Value -> Datum
toDatum (VF Double
x) = Double -> Datum
forall n. Real n => n -> Datum
O.float Double
x
toDatum (VN Note
x) = Note -> Datum
forall n. Real n => n -> Datum
O.float Note
x
toDatum (VI Int
x) = Int -> Datum
forall n. Integral n => n -> Datum
O.int32 Int
x
toDatum (VS String
x) = String -> Datum
O.string String
x
toDatum (VR 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 Bool
True) = Int -> Datum
forall n. Integral n => n -> Datum
O.int32 (Int
1 :: Int)
toDatum (VB Bool
False) = Int -> Datum
forall n. Integral n => n -> Datum
O.int32 (Int
0 :: Int)
toDatum (VX [Word8]
xs) = BLOB -> Datum
O.Blob (BLOB -> Datum) -> BLOB -> Datum
forall a b. (a -> b) -> a -> b
$ [Word8] -> BLOB
O.blob_pack [Word8]
xs
toDatum Value
_ = String -> Datum
forall a. HasCallStack => String -> a
error String
"toDatum: unhandled value"
  
toData :: OSC -> Event ValueMap -> Maybe [O.Datum]
toData :: OSC -> Event ValueMap -> Maybe [Datum]
toData (OSC {args :: OSC -> Args
args = ArgList [(String, Maybe Value)]
as}) Event ValueMap
e = ([Value] -> [Datum]) -> Maybe [Value] -> Maybe [Datum]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Value -> Datum) -> [Value] -> [Datum]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Value -> Datum
toDatum)) (Maybe [Value] -> Maybe [Datum]) -> Maybe [Value] -> Maybe [Datum]
forall a b. (a -> b) -> a -> b
$ [Maybe Value] -> Maybe [Value]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Maybe Value] -> Maybe [Value]) -> [Maybe Value] -> Maybe [Value]
forall a b. (a -> b) -> a -> b
$ ((String, Maybe Value) -> Maybe Value)
-> [(String, Maybe Value)] -> [Maybe Value]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
n,Maybe Value
v) -> String -> ValueMap -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
n (Event ValueMap -> ValueMap
forall a b. EventF a b -> b
value Event ValueMap
e) Maybe Value -> Maybe Value -> Maybe Value
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Value
v) [(String, Maybe Value)]
as
toData (OSC {args :: OSC -> Args
args = Named [String]
rqrd}) Event ValueMap
e
  | [String] -> Bool
hasRequired [String]
rqrd = [Datum] -> Maybe [Datum]
forall a. a -> Maybe a
Just ([Datum] -> Maybe [Datum]) -> [Datum] -> Maybe [Datum]
forall a b. (a -> b) -> a -> b
$ ((String, Value) -> [Datum]) -> [(String, Value)] -> [Datum]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(String
n,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
$ ValueMap -> [(String, Value)]
forall k a. Map k a -> [(k, a)]
Map.toList (ValueMap -> [(String, Value)]) -> ValueMap -> [(String, Value)]
forall a b. (a -> b) -> a -> b
$ Event ValueMap -> ValueMap
forall a b. EventF a b -> b
value Event ValueMap
e
  | Bool
otherwise = Maybe [Datum]
forall a. Maybe a
Nothing
  where hasRequired :: [String] -> Bool
hasRequired [] = Bool
True
        hasRequired [String]
xs = [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> Bool) -> [String] -> Bool
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
ks)) [String]
xs
        ks :: [String]
ks = ValueMap -> [String]
forall k a. Map k a -> [k]
Map.keys (Event ValueMap -> ValueMap
forall a b. EventF a b -> b
value Event ValueMap
e)
toData OSC
_ Event ValueMap
_ = Maybe [Datum]
forall a. Maybe a
Nothing

substitutePath :: String -> ValueMap -> Maybe String
substitutePath :: String -> ValueMap -> Maybe String
substitutePath String
str ValueMap
cm = String -> Maybe String
parse String
str
  where parse :: String -> Maybe String
parse [] = String -> Maybe String
forall a. a -> Maybe a
Just []
        parse (Char
'{':String
xs) = String -> Maybe String
parseWord String
xs
        parse (Char
x:String
xs) = do String
xs' <- String -> Maybe String
parse String
xs
                          String -> Maybe String
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:String
xs')
        parseWord :: String -> Maybe String
parseWord String
xs | String
b String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== [] = ValueMap -> String -> Maybe String
getString ValueMap
cm String
a
                     | Bool
otherwise = do String
v <- ValueMap -> String -> Maybe String
getString ValueMap
cm String
a
                                      String
xs' <- String -> Maybe String
parse (ShowS
forall a. [a] -> [a]
tail String
b)
                                      String -> Maybe String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
xs'
          where (String
a,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
== Char
'}') String
xs

getString :: ValueMap -> String -> Maybe String
getString :: ValueMap -> String -> Maybe String
getString ValueMap
cm String
s = Maybe String -> Maybe String
defaultValue (Maybe String -> Maybe String) -> Maybe String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Value -> String
simpleShow (Value -> String) -> Maybe Value -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ValueMap -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
s ValueMap
cm
                      where simpleShow :: Value -> String
                            simpleShow :: Value -> String
simpleShow (VS String
str) = String
str
                            simpleShow (VI Int
i) = Int -> String
forall a. Show a => a -> String
show Int
i
                            simpleShow (VF Double
f) = Double -> String
forall a. Show a => a -> String
show Double
f
                            simpleShow (VN Note
n) = Note -> String
forall a. Show a => a -> String
show Note
n
                            simpleShow (VR Rational
r) = Rational -> String
forall a. Show a => a -> String
show Rational
r
                            simpleShow (VB Bool
b) = Bool -> String
forall a. Show a => a -> String
show Bool
b
                            simpleShow (VX [Word8]
xs) = [Word8] -> String
forall a. Show a => a -> String
show [Word8]
xs
                            simpleShow (VState ValueMap -> (ValueMap, Value)
_) = ShowS
forall a. Show a => a -> String
show String
"<stateful>"
                            simpleShow (VPattern Pattern Value
_) = ShowS
forall a. Show a => a -> String
show String
"<pattern>"
                            simpleShow (VList [Value]
_) = ShowS
forall a. Show a => a -> String
show String
"<list>"
                            (String
_, String
dflt) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=') String
s
                            defaultValue :: Maybe String -> Maybe String
                            defaultValue :: Maybe String -> Maybe String
defaultValue Maybe String
Nothing | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
dflt = Maybe String
forall a. Maybe a
Nothing
                                                 | Bool
otherwise = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. [a] -> [a]
tail String
dflt
                            defaultValue Maybe String
x = Maybe String
x

playStack :: PlayMap -> ControlPattern
playStack :: PlayMap -> ControlPattern
playStack PlayMap
pMap = [ControlPattern] -> ControlPattern
forall a. [Pattern a] -> Pattern a
stack ([ControlPattern] -> ControlPattern)
-> [ControlPattern] -> ControlPattern
forall a b. (a -> b) -> a -> b
$ (PlayState -> ControlPattern) -> [PlayState] -> [ControlPattern]
forall a b. (a -> b) -> [a] -> [b]
map PlayState -> ControlPattern
pattern [PlayState]
active
  where active :: [PlayState]
active = (PlayState -> Bool) -> [PlayState] -> [PlayState]
forall a. (a -> Bool) -> [a] -> [a]
filter (\PlayState
pState -> if PlayMap -> Bool
forall k. Map k PlayState -> Bool
hasSolo PlayMap
pMap
                                    then PlayState -> Bool
solo PlayState
pState
                                    else Bool -> Bool
not (PlayState -> Bool
mute PlayState
pState)
                        ) ([PlayState] -> [PlayState]) -> [PlayState] -> [PlayState]
forall a b. (a -> b) -> a -> b
$ PlayMap -> [PlayState]
forall k a. Map k a -> [a]
Map.elems PlayMap
pMap

toOSC :: Double -> [Int] -> Event ValueMap -> T.Tempo -> OSC -> [(Double, Bool, O.Message)]
toOSC :: Double
-> [Int]
-> Event ValueMap
-> Tempo
-> OSC
-> [(Double, Bool, Message)]
toOSC Double
latency [Int]
busses Event ValueMap
e Tempo
tempo osc :: OSC
osc@(OSC String
_ Args
_)
  = [Maybe (Double, Bool, Message)] -> [(Double, Bool, Message)]
forall a. [Maybe a] -> [a]
catMaybes (Maybe (Double, Bool, Message)
playmsgMaybe (Double, Bool, Message)
-> [Maybe (Double, Bool, Message)]
-> [Maybe (Double, Bool, Message)]
forall a. a -> [a] -> [a]
:[Maybe (Double, Bool, Message)]
busmsgs)
       where (ValueMap
playmap, ValueMap
busmap) = (String -> Value -> Bool) -> ValueMap -> (ValueMap, ValueMap)
forall k a. (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
Map.partitionWithKey (\String
k Value
_ -> String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
k Bool -> Bool -> Bool
|| String -> Char
forall a. [a] -> a
head String
k Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'^') (ValueMap -> (ValueMap, ValueMap))
-> ValueMap -> (ValueMap, ValueMap)
forall a b. (a -> b) -> a -> b
$ Event ValueMap -> ValueMap
forall a b. EventF a b -> b
value Event ValueMap
e
             -- swap in bus ids where needed
             playmap' :: ValueMap
playmap' = ValueMap -> ValueMap -> ValueMap
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union (ShowS -> ValueMap -> ValueMap
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys ShowS
forall a. [a] -> [a]
tail (ValueMap -> ValueMap) -> ValueMap -> ValueMap
forall a b. (a -> b) -> a -> b
$ (Value -> Value) -> ValueMap -> ValueMap
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\(VI Int
i) -> String -> Value
VS (Char
'c'Char -> ShowS
forall a. a -> [a] -> [a]
:(Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Int -> Int
toBus Int
i))) ValueMap
busmap) ValueMap
playmap
             addExtra :: ValueMap
addExtra = ValueMap -> ValueMap -> ValueMap
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union ValueMap
playmap' ValueMap
extra
             playmsg :: Maybe (Double, Bool, Message)
playmsg | Event ValueMap -> Bool
forall a. Event a -> Bool
eventHasOnset Event ValueMap
e = do [Datum]
vs <- OSC -> Event ValueMap -> Maybe [Datum]
toData OSC
osc (Event ValueMap
e {value :: ValueMap
value = ValueMap
addExtra})
                                            String
mungedPath <- String -> ValueMap -> Maybe String
substitutePath (OSC -> String
path OSC
osc) ValueMap
playmap'
                                            (Double, Bool, Message) -> Maybe (Double, Bool, Message)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
ts,
                                                    Bool
False, -- bus message ?
                                                    String -> [Datum] -> Message
O.Message String
mungedPath [Datum]
vs
                                                   )
                     | Bool
otherwise = Maybe (Double, Bool, Message)
forall a. Maybe a
Nothing
             toBus :: Int -> Int
toBus Int
n | [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
busses = Int
n
                     | Bool
otherwise = [Int]
busses [Int] -> Int -> Int
forall a. [a] -> Int -> a
!!! Int
n
             busmsgs :: [Maybe (Double, Bool, Message)]
busmsgs = ((String, Value) -> Maybe (Double, Bool, Message))
-> [(String, Value)] -> [Maybe (Double, Bool, Message)]
forall a b. (a -> b) -> [a] -> [b]
map
                         (\((Char
'^':String
k), (VI Int
b)) -> do Value
v <- String -> ValueMap -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
k ValueMap
playmap
                                                   (Double, Bool, Message) -> Maybe (Double, Bool, Message)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Double, Bool, Message) -> Maybe (Double, Bool, Message))
-> (Double, Bool, Message) -> Maybe (Double, Bool, Message)
forall a b. (a -> b) -> a -> b
$ (Double
tsPart,
                                                             Bool
True, -- bus message ?
                                                             String -> [Datum] -> Message
O.Message String
"/c_set" [Int -> Datum
forall n. Integral n => n -> Datum
O.int32 Int
b, Value -> Datum
toDatum Value
v]
                                                            )
                         )
                         (ValueMap -> [(String, Value)]
forall k a. Map k a -> [(k, a)]
Map.toList ValueMap
busmap)
             onPart :: Double
onPart = Tempo -> Rational -> Double
sched Tempo
tempo (Rational -> Double) -> Rational -> Double
forall a b. (a -> b) -> a -> b
$ Arc -> Rational
forall a. ArcF a -> a
start (Arc -> Rational) -> Arc -> Rational
forall a b. (a -> b) -> a -> b
$ Event ValueMap -> Arc
forall a b. EventF a b -> a
part Event ValueMap
e
             on :: Double
on = Tempo -> Rational -> Double
sched Tempo
tempo (Rational -> Double) -> Rational -> Double
forall a b. (a -> b) -> a -> b
$ Arc -> Rational
forall a. ArcF a -> a
start (Arc -> Rational) -> Arc -> Rational
forall a b. (a -> b) -> a -> b
$ Event ValueMap -> Arc
forall a. Event a -> Arc
wholeOrPart Event ValueMap
e
             off :: Double
off = Tempo -> Rational -> Double
sched Tempo
tempo (Rational -> Double) -> Rational -> Double
forall a b. (a -> b) -> a -> b
$ Arc -> Rational
forall a. ArcF a -> a
stop (Arc -> Rational) -> Arc -> Rational
forall a b. (a -> b) -> a -> b
$ Event ValueMap -> Arc
forall a. Event a -> Arc
wholeOrPart Event ValueMap
e
             delta :: Double
delta = Double
off Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
on
             -- If there is already cps in the event, the union will preserve that.
             extra :: ValueMap
extra = [(String, Value)] -> ValueMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(String
"cps", (Double -> Value
VF (Tempo -> Double
T.cps Tempo
tempo))),
                                   (String
"delta", Double -> Value
VF Double
delta),
                                   (String
"cycle", Double -> Value
VF (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Rational -> Double) -> Rational -> Double
forall a b. (a -> b) -> a -> b
$ Arc -> Rational
forall a. ArcF a -> a
start (Arc -> Rational) -> Arc -> Rational
forall a b. (a -> b) -> a -> b
$ Event ValueMap -> Arc
forall a. Event a -> Arc
wholeOrPart Event ValueMap
e)) 
                                 ]
             nudge :: Double
nudge = Maybe Double -> Double
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Double -> Double) -> Maybe Double -> Double
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Double
getF (Value -> Maybe Double) -> Value -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe (Double -> Value
VF Double
0) (Maybe Value -> Value) -> Maybe Value -> Value
forall a b. (a -> b) -> a -> b
$ String -> ValueMap -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
"nudge" (ValueMap -> Maybe Value) -> ValueMap -> Maybe Value
forall a b. (a -> b) -> a -> b
$ ValueMap
playmap
             ts :: Double
ts = Double
on Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
nudge Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
latency
             tsPart :: Double
tsPart = Double
onPart Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
nudge Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
latency

toOSC Double
latency [Int]
_ Event ValueMap
e Tempo
tempo (OSCContext String
oscpath)
  = (((Int, Int), (Int, Int)) -> (Double, Bool, Message))
-> [((Int, Int), (Int, Int))] -> [(Double, Bool, Message)]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Int), (Int, Int)) -> (Double, Bool, Message)
cToM ([((Int, Int), (Int, Int))] -> [(Double, Bool, Message)])
-> [((Int, Int), (Int, Int))] -> [(Double, Bool, Message)]
forall a b. (a -> b) -> a -> b
$ Context -> [((Int, Int), (Int, Int))]
contextPosition (Context -> [((Int, Int), (Int, Int))])
-> Context -> [((Int, Int), (Int, Int))]
forall a b. (a -> b) -> a -> b
$ Event ValueMap -> Context
forall a b. EventF a b -> Context
context Event ValueMap
e
  where cToM :: ((Int,Int),(Int,Int)) -> (Double, Bool, O.Message)
        cToM :: ((Int, Int), (Int, Int)) -> (Double, Bool, Message)
cToM ((Int
x, Int
y), (Int
x',Int
y')) = (Double
ts,
                                  Bool
False, -- bus message ?
                                  String -> [Datum] -> Message
O.Message String
oscpath ([Datum] -> Message) -> [Datum] -> Message
forall a b. (a -> b) -> a -> b
$ (Double -> Datum
forall n. Real n => n -> Datum
O.float Double
delta)Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
:(Double -> Datum
forall n. Real n => n -> Datum
O.float Double
cyc)Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
:((Int -> Datum) -> [Int] -> [Datum]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Datum
forall n. Integral n => n -> Datum
O.int32 [Int
x,Int
y,Int
x',Int
y'])
                                 )
        on :: Double
on = Tempo -> Rational -> Double
sched Tempo
tempo (Rational -> Double) -> Rational -> Double
forall a b. (a -> b) -> a -> b
$ Arc -> Rational
forall a. ArcF a -> a
start (Arc -> Rational) -> Arc -> Rational
forall a b. (a -> b) -> a -> b
$ Event ValueMap -> Arc
forall a. Event a -> Arc
wholeOrPart Event ValueMap
e
        off :: Double
off = Tempo -> Rational -> Double
sched Tempo
tempo (Rational -> Double) -> Rational -> Double
forall a b. (a -> b) -> a -> b
$ Arc -> Rational
forall a. ArcF a -> a
stop (Arc -> Rational) -> Arc -> Rational
forall a b. (a -> b) -> a -> b
$ Event ValueMap -> Arc
forall a. Event a -> Arc
wholeOrPart Event ValueMap
e
        delta :: Double
delta = Double
off Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
on
        cyc :: Double
        cyc :: Double
cyc = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Rational -> Double) -> Rational -> Double
forall a b. (a -> b) -> a -> b
$ Arc -> Rational
forall a. ArcF a -> a
start (Arc -> Rational) -> Arc -> Rational
forall a b. (a -> b) -> a -> b
$ Event ValueMap -> Arc
forall a. Event a -> Arc
wholeOrPart Event ValueMap
e
        nudge :: Double
nudge = Maybe Double -> Double
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Double -> Double) -> Maybe Double -> Double
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Double
getF (Value -> Maybe Double) -> Value -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe (Double -> Value
VF Double
0) (Maybe Value -> Value) -> Maybe Value -> Value
forall a b. (a -> b) -> a -> b
$ String -> ValueMap -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
"nudge" (ValueMap -> Maybe Value) -> ValueMap -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Event ValueMap -> ValueMap
forall a b. EventF a b -> b
value Event ValueMap
e
        ts :: Double
ts = Double
on Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
nudge Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
latency

doCps :: MVar T.Tempo -> (Double, Maybe Value) -> IO ()
doCps :: MVar Tempo -> (Double, Maybe Value) -> IO ()
doCps MVar Tempo
tempoMV (Double
d, Just (VF 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
* Double
1000000
                      -- hack to stop things from stopping !
                      -- TODO is this still needed?
                      Tempo
_ <- MVar Tempo -> Double -> IO Tempo
T.setCps MVar Tempo
tempoMV (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
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 MVar Tempo
_ (Double, Maybe Value)
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

onTick :: Stream -> T.State -> IO ()
onTick :: Stream -> State -> IO ()
onTick Stream
stream State
st
  = do Bool -> Stream -> State -> IO ()
doTick Bool
False Stream
stream State
st

processCps :: T.Tempo -> [Event ValueMap] -> ([(T.Tempo, Event ValueMap)], T.Tempo)
processCps :: Tempo -> [Event ValueMap] -> ([(Tempo, Event ValueMap)], Tempo)
processCps Tempo
t [] = ([], Tempo
t)
-- If an event has a tempo change, that affects the following events..
processCps Tempo
t (Event ValueMap
e:[Event ValueMap]
evs) = (((Tempo
t', Event ValueMap
e)(Tempo, Event ValueMap)
-> [(Tempo, Event ValueMap)] -> [(Tempo, Event ValueMap)]
forall a. a -> [a] -> [a]
:[(Tempo, Event ValueMap)]
es'), Tempo
t'')
  where cps' :: Maybe Double
cps' | Event ValueMap -> Bool
forall a. Event a -> Bool
eventHasOnset Event ValueMap
e = do Value
x <- String -> ValueMap -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
"cps" (ValueMap -> Maybe Value) -> ValueMap -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Event ValueMap -> ValueMap
forall a b. EventF a b -> b
value Event ValueMap
e
                                    Value -> Maybe Double
getF Value
x
             | Bool
otherwise = Maybe Double
forall a. Maybe a
Nothing
        t' :: Tempo
t' = (Tempo -> (Double -> Tempo) -> Maybe Double -> Tempo
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Tempo
t (\Double
newCps -> Tempo -> Double -> Rational -> Tempo
T.changeTempo' Tempo
t Double
newCps (Event ValueMap -> Rational
forall a. Event a -> Rational
eventPartStart Event ValueMap
e)) Maybe Double
cps')
        ([(Tempo, Event ValueMap)]
es', Tempo
t'') = Tempo -> [Event ValueMap] -> ([(Tempo, Event ValueMap)], Tempo)
processCps Tempo
t' [Event ValueMap]
evs

streamOnce :: Stream -> ControlPattern -> IO ()
streamOnce :: Stream -> ControlPattern -> IO ()
streamOnce Stream
st ControlPattern
p = do Int
i <- (StdGen -> (Int, StdGen)) -> IO Int
forall (m :: * -> *) a. MonadIO m => (StdGen -> (a, StdGen)) -> m 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 (Int
0, Int
8192)
                     Stream -> ControlPattern -> IO ()
streamFirst Stream
st (ControlPattern -> IO ()) -> ControlPattern -> IO ()
forall a b. (a -> b) -> a -> b
$ Rational -> ControlPattern -> ControlPattern
forall a. Rational -> Pattern a -> Pattern a
rotL (Int -> Rational
forall a. Real a => a -> Rational
toRational (Int
i :: Int)) ControlPattern
p

streamFirst :: Stream -> ControlPattern -> IO ()
streamFirst :: Stream -> ControlPattern -> IO ()
streamFirst Stream
stream ControlPattern
pat = do Double
now <- IO Double
forall (m :: * -> *). MonadIO m => m Double
O.time
                            Tempo
tempo <- MVar Tempo -> IO Tempo
forall a. MVar a -> IO a
readMVar (Stream -> MVar Tempo
sTempoMV Stream
stream)
                            MVar PlayMap
pMapMV <- PlayMap -> IO (MVar PlayMap)
forall a. a -> IO (MVar a)
newMVar (PlayMap -> IO (MVar PlayMap)) -> PlayMap -> IO (MVar PlayMap)
forall a b. (a -> b) -> a -> b
$ String -> PlayState -> PlayMap
forall k a. k -> a -> Map k a
Map.singleton String
"fake"
                                      (PlayState :: ControlPattern -> Bool -> Bool -> [ControlPattern] -> PlayState
PlayState {pattern :: ControlPattern
pattern = ControlPattern
pat,
                                                  mute :: Bool
mute = Bool
False,
                                                  solo :: Bool
solo = Bool
False,
                                                  history :: [ControlPattern]
history = []
                                                 }
                                      )
                            let cps :: Double
cps = Tempo -> Double
T.cps Tempo
tempo
                                state :: State
state = State :: Int -> Double -> (Double, Double) -> Arc -> Bool -> State
T.State {ticks :: Int
T.ticks = Int
0,
                                                 start :: Double
T.start = Double
now,
                                                 nowTimespan :: (Double, Double)
T.nowTimespan = (Double
now, Double
now Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
cps)),
                                                 starting :: Bool
T.starting = Bool
True, -- really?
                                                 nowArc :: Arc
T.nowArc = (Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc Rational
0 Rational
1)
                                                }
                            Bool -> Stream -> State -> IO ()
doTick Bool
True (Stream
stream {sPMapMV :: MVar PlayMap
sPMapMV = MVar PlayMap
pMapMV}) State
state

-- | Query the current pattern (contained in argument @stream :: Stream@)
-- for the events in the current arc (contained in argument @st :: T.State@),
-- translate them to OSC messages, and send these.
--
-- If an exception occurs during sending,
-- this functions prints a warning and continues, because
-- the likely reason is that the backend (supercollider) isn't running.
-- 
-- If any exception occurs before or outside sending
-- (e.g., while querying the pattern, while computing a message),
-- this function prints a warning and resets the current pattern
-- to the previous one (or to silence if there isn't one) and continues,
-- because the likely reason is that something is wrong with the current pattern.
doTick :: Bool -> Stream -> T.State -> IO ()
doTick :: Bool -> Stream -> State -> IO ()
doTick Bool
fake Stream
stream State
st =
  (SomeException -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
E.handle (\ (SomeException
e :: E.SomeException) -> do
    Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Failed to Stream.doTick: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SomeException -> String
forall a. Show a => a -> String
show SomeException
e
    Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Return to previous pattern."
    Stream -> IO ()
setPreviousPatternOrSilence Stream
stream
           ) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
  ((Tempo, ValueMap) -> IO (Tempo, ValueMap)) -> IO ()
modifyState (((Tempo, ValueMap) -> IO (Tempo, ValueMap)) -> IO ())
-> ((Tempo, ValueMap) -> IO (Tempo, ValueMap)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Tempo
tempo, ValueMap
sMap) -> do
     PlayMap
pMap <- MVar PlayMap -> IO PlayMap
forall a. MVar a -> IO a
readMVar (Stream -> MVar PlayMap
sPMapMV Stream
stream)
     [Int]
busses <- MVar [Int] -> IO [Int]
forall a. MVar a -> IO a
readMVar (Stream -> MVar [Int]
sBusses Stream
stream)
     ControlPattern -> ControlPattern
sGlobalF <- MVar (ControlPattern -> ControlPattern)
-> IO (ControlPattern -> ControlPattern)
forall a. MVar a -> IO a
readMVar (Stream -> MVar (ControlPattern -> ControlPattern)
sGlobalFMV Stream
stream)
     -- putStrLn $ show st
     let config :: Config
config = Stream -> Config
sConfig Stream
stream
         cxs :: [Cx]
cxs = Stream -> [Cx]
sCxs Stream
stream
         cycleNow :: Rational
cycleNow = Tempo -> Double -> Rational
T.timeToCycles Tempo
tempo (Double -> Rational) -> Double -> Rational
forall a b. (a -> b) -> a -> b
$ State -> Double
T.start State
st
         patstack :: ControlPattern
patstack = ControlPattern -> ControlPattern
sGlobalF (ControlPattern -> ControlPattern)
-> ControlPattern -> ControlPattern
forall a b. (a -> b) -> a -> b
$ PlayMap -> ControlPattern
playStack PlayMap
pMap
         -- If a 'fake' tick, it'll be aligned with cycle zero
         pat :: ControlPattern
pat | Bool
fake = (Rational -> Rational) -> ControlPattern -> ControlPattern
forall a. (Rational -> Rational) -> Pattern a -> Pattern a
withResultTime (Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
cycleNow) ControlPattern
patstack
             | Bool
otherwise = ControlPattern
patstack
         frameEnd :: Double
frameEnd = (Double, Double) -> Double
forall a b. (a, b) -> b
snd ((Double, Double) -> Double) -> (Double, Double) -> Double
forall a b. (a -> b) -> a -> b
$ State -> (Double, Double)
T.nowTimespan State
st
         -- add cps to state
         sMap' :: ValueMap
sMap' = String -> Value -> ValueMap -> ValueMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
"_cps" (Double -> Value
VF (Tempo -> Double
T.cps Tempo
tempo)) ValueMap
sMap
         --filterOns = filter eventHasOnset
         extraLatency :: Double
extraLatency | Bool
fake = Double
0
                      | Bool
otherwise = Config -> Double
cFrameTimespan Config
config Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Tempo -> Double
T.nudged Tempo
tempo
         -- First the state is used to query the pattern
         es :: [Event ValueMap]
es = (Event ValueMap -> Rational)
-> [Event ValueMap] -> [Event ValueMap]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Arc -> Rational
forall a. ArcF a -> a
start (Arc -> Rational)
-> (Event ValueMap -> Arc) -> Event ValueMap -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event ValueMap -> Arc
forall a b. EventF a b -> a
part) ([Event ValueMap] -> [Event ValueMap])
-> [Event ValueMap] -> [Event ValueMap]
forall a b. (a -> b) -> a -> b
$ ControlPattern -> State -> [Event ValueMap]
forall a. Pattern a -> State -> [Event a]
query ControlPattern
pat (State :: Arc -> ValueMap -> State
State {arc :: Arc
arc = State -> Arc
T.nowArc State
st,
                                                        controls :: ValueMap
controls = ValueMap
sMap'
                                                       }
                                                )
         -- Then it's passed through the events
         (ValueMap
sMap'', [Event ValueMap]
es') = ValueMap -> [Event ValueMap] -> (ValueMap, [Event ValueMap])
resolveState ValueMap
sMap' [Event ValueMap]
es
         
         -- TODO onset is calculated in toOSC as well..
         on :: Event a -> Tempo -> Double
on Event a
e Tempo
tempo'' = (Tempo -> Rational -> Double
sched Tempo
tempo'' (Rational -> Double) -> Rational -> Double
forall a b. (a -> b) -> a -> b
$ Arc -> Rational
forall a. ArcF a -> a
start (Arc -> Rational) -> Arc -> Rational
forall a b. (a -> b) -> a -> b
$ Event a -> Arc
forall a. Event a -> Arc
wholeOrPart Event a
e)
         ([(Tempo, Event ValueMap)]
tes, Tempo
tempo') = Tempo -> [Event ValueMap] -> ([(Tempo, Event ValueMap)], Tempo)
processCps Tempo
tempo ([Event ValueMap] -> ([(Tempo, Event ValueMap)], Tempo))
-> [Event ValueMap] -> ([(Tempo, Event ValueMap)], Tempo)
forall a b. (a -> b) -> a -> b
$ [Event ValueMap]
es'
     [Cx] -> (Cx -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Cx]
cxs ((Cx -> IO ()) -> IO ()) -> (Cx -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \cx :: Cx
cx@(Cx Target
target UDP
_ [OSC]
oscs AddrInfo
_ Maybe AddrInfo
_) -> do
         let latency :: Double
latency = Target -> Double
oLatency Target
target Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
extraLatency
             ms :: [(Double, Bool, Message)]
ms = ((Tempo, Event ValueMap) -> [(Double, Bool, Message)])
-> [(Tempo, Event ValueMap)] -> [(Double, Bool, Message)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Tempo
t, Event ValueMap
e) ->
                              if (Bool
fake Bool -> Bool -> Bool
|| (Event ValueMap -> Tempo -> Double
forall a. Event a -> Tempo -> Double
on Event ValueMap
e Tempo
t) Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
frameEnd)
                              then (OSC -> [(Double, Bool, Message)])
-> [OSC] -> [(Double, Bool, Message)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Double
-> [Int]
-> Event ValueMap
-> Tempo
-> OSC
-> [(Double, Bool, Message)]
toOSC Double
latency [Int]
busses Event ValueMap
e Tempo
t) [OSC]
oscs
                              else []
                          ) [(Tempo, Event ValueMap)]
tes
         [(Double, Bool, Message)]
-> ((Double, Bool, Message) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Double, Bool, Message)]
ms (((Double, Bool, Message) -> IO ()) -> IO ())
-> ((Double, Bool, Message) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ (Double, Bool, Message)
m -> Maybe UDP -> Cx -> (Double, Bool, Message) -> IO ()
send (Stream -> Maybe UDP
sListen Stream
stream) Cx
cx (Double, Bool, Message)
m IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \ (SomeException
e :: E.SomeException) -> do
           Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Failed to send. Is the '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Target -> String
oName Target
target String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' target running? " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SomeException -> String
forall a. Show a => a -> String
show SomeException
e

     (Tempo
tempo', ValueMap
sMap'') (Tempo, ValueMap) -> IO (Tempo, ValueMap) -> IO (Tempo, ValueMap)
`seq` (Tempo, ValueMap) -> IO (Tempo, ValueMap)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tempo
tempo', ValueMap
sMap'')
  where modifyState :: ((T.Tempo, ValueMap) -> IO (T.Tempo, ValueMap)) -> IO ()
        modifyState :: ((Tempo, ValueMap) -> IO (Tempo, ValueMap)) -> IO ()
modifyState (Tempo, ValueMap) -> IO (Tempo, ValueMap)
io = ((forall a. IO a -> IO a) -> IO ()) -> IO ()
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
E.mask (((forall a. IO a -> IO a) -> IO ()) -> IO ())
-> ((forall a. IO a -> IO a) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
          ValueMap
s <- MVar ValueMap -> IO ValueMap
forall a. MVar a -> IO a
takeMVar (Stream -> MVar ValueMap
sStateMV Stream
stream)
          Tempo
t <- MVar Tempo -> IO Tempo
forall a. MVar a -> IO a
takeMVar (Stream -> MVar Tempo
sTempoMV Stream
stream)
          (Tempo
t', ValueMap
s') <- IO (Tempo, ValueMap) -> IO (Tempo, ValueMap)
forall a. IO a -> IO a
restore ((Tempo, ValueMap) -> IO (Tempo, ValueMap)
io (Tempo
t, ValueMap
s)) IO (Tempo, ValueMap) -> IO () -> IO (Tempo, ValueMap)
forall a b. IO a -> IO b -> IO a
`E.onException` (do {MVar ValueMap -> ValueMap -> IO ()
forall a. MVar a -> a -> IO ()
putMVar (Stream -> MVar ValueMap
sStateMV Stream
stream) ValueMap
s; MVar Tempo -> Tempo -> IO ()
forall a. MVar a -> a -> IO ()
putMVar (Stream -> MVar Tempo
sTempoMV Stream
stream) Tempo
t; () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()})
          MVar ValueMap -> ValueMap -> IO ()
forall a. MVar a -> a -> IO ()
putMVar (Stream -> MVar ValueMap
sStateMV Stream
stream) ValueMap
s'
          MVar Tempo -> Tempo -> IO ()
forall a. MVar a -> a -> IO ()
putMVar (Stream -> MVar Tempo
sTempoMV Stream
stream) Tempo
t'

setPreviousPatternOrSilence :: Stream -> IO ()
setPreviousPatternOrSilence :: Stream -> IO ()
setPreviousPatternOrSilence Stream
stream =
  MVar PlayMap -> (PlayMap -> IO PlayMap) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (Stream -> MVar PlayMap
sPMapMV Stream
stream) ((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 a b k. (a -> b) -> Map k a -> Map k b
Map.map ( \ PlayState
pMap -> case PlayState -> [ControlPattern]
history PlayState
pMap of
      ControlPattern
_:ControlPattern
p:[ControlPattern]
ps -> PlayState
pMap { pattern :: ControlPattern
pattern = ControlPattern
p, history :: [ControlPattern]
history = ControlPattern
pControlPattern -> [ControlPattern] -> [ControlPattern]
forall a. a -> [a] -> [a]
:[ControlPattern]
ps }
      [ControlPattern]
_ -> PlayState
pMap { pattern :: ControlPattern
pattern = ControlPattern
forall a. Pattern a
silence, history :: [ControlPattern]
history = [ControlPattern
forall a. Pattern a
silence] }
              )
      
send :: Maybe O.UDP -> Cx -> (Double, Bool, O.Message) -> IO ()
send :: Maybe UDP -> Cx -> (Double, Bool, Message) -> IO ()
send Maybe UDP
listen Cx
cx (Double
time, Bool
isBusMsg, Message
m)
  | Target -> Schedule
oSchedule Target
target Schedule -> Schedule -> Bool
forall a. Eq a => a -> a -> Bool
== StampStyle -> Schedule
Pre StampStyle
BundleStamp = Bool -> Maybe UDP -> Cx -> Bundle -> IO ()
sendBndl Bool
isBusMsg Maybe UDP
listen Cx
cx (Bundle -> IO ()) -> Bundle -> IO ()
forall a b. (a -> b) -> a -> b
$ Double -> [Message] -> Bundle
O.Bundle Double
time [Message
m]
  | Target -> Schedule
oSchedule Target
target Schedule -> Schedule -> Bool
forall a. Eq a => a -> a -> Bool
== StampStyle -> Schedule
Pre StampStyle
MessageStamp = Bool -> Maybe UDP -> Cx -> Message -> IO ()
sendO Bool
isBusMsg Maybe UDP
listen Cx
cx (Message -> IO ()) -> Message -> IO ()
forall a b. (a -> b) -> a -> b
$ Message -> Message
addtime Message
m
  | Bool
otherwise = do ThreadId
_ <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do Double
now <- IO Double
forall (m :: * -> *). MonadIO m => m Double
O.time
                                    Int -> IO ()
threadDelay (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ (Double
time Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
now) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000000
                                    Bool -> Maybe UDP -> Cx -> Message -> IO ()
sendO Bool
isBusMsg Maybe UDP
listen Cx
cx Message
m
                   () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    where addtime :: Message -> Message
addtime (O.Message String
mpath [Datum]
params) = String -> [Datum] -> Message
O.Message String
mpath ((Int -> Datum
forall n. Integral n => n -> Datum
O.int32 Int
sec)Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
:((Int -> Datum
forall n. Integral n => n -> Datum
O.int32 Int
usec)Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
:[Datum]
params))
          ut :: Double
ut = Double -> Double
forall n. Num n => n -> n
O.ntpr_to_ut Double
time
          sec :: Int
          sec :: Int
sec = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
ut
          usec :: Int
          usec :: Int
usec = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double
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))
          target :: Target
target = Cx -> Target
cxTarget Cx
cx

sched :: T.Tempo -> Rational -> Double
sched :: Tempo -> Rational -> Double
sched Tempo
tempo 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 Stream
s 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 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
>= Int
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 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 Bool
True  (String
k, (PlayState {solo :: PlayState -> Bool
solo = Bool
True})) = String
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" - solo\n"
        showKV Bool
True  (String
k, PlayState
_) = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")\n"
        showKV Bool
False (String
k, (PlayState {solo :: PlayState -> Bool
solo = Bool
False})) = String
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
        showKV Bool
False (String
k, PlayState
_) = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") - 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 Stream
s 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 ValueMap]
x = ControlPattern -> Arc -> [Event ValueMap]
forall a. Pattern a -> Arc -> [Event a]
queryArc ControlPattern
pat (Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc Rational
0 Rational
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
                ValueMap
input <- MVar ValueMap -> IO ValueMap
forall a. MVar a -> IO a
takeMVar (MVar ValueMap -> IO ValueMap) -> MVar ValueMap -> IO ValueMap
forall a b. (a -> b) -> a -> b
$ Stream -> MVar ValueMap
sStateMV 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 ValueMap -> ValueMap -> IO ()
forall a. MVar a -> a -> IO ()
putMVar (Stream -> MVar ValueMap
sStateMV Stream
s) (ValueMap -> IO ()) -> ValueMap -> IO ()
forall a b. (a -> b) -> a -> b
$
                  String -> Value -> ValueMap -> ValueMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (String
"_t_all") (Rational -> Value
VR Rational
cyc) (ValueMap -> ValueMap) -> ValueMap -> ValueMap
forall a b. (a -> b) -> a -> b
$ String -> Value -> ValueMap -> ValueMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (String
"_t_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
k) (Rational -> Value
VR Rational
cyc) ValueMap
input
                -- update the pattern itself
                PlayMap
pMap <- [Event ValueMap] -> IO PlayMap -> IO PlayMap
seq [Event ValueMap]
x (IO PlayMap -> IO PlayMap) -> IO PlayMap -> IO PlayMap
forall a b. (a -> b) -> a -> b
$ MVar PlayMap -> IO PlayMap
forall a. MVar a -> IO a
takeMVar (MVar PlayMap -> IO PlayMap) -> MVar PlayMap -> IO PlayMap
forall a b. (a -> b) -> a -> b
$ Stream -> MVar PlayMap
sPMapMV Stream
s
                let playState :: PlayState
playState = Maybe PlayState -> PlayState
updatePS (Maybe PlayState -> PlayState) -> Maybe PlayState -> PlayState
forall a b. (a -> b) -> a -> b
$ String -> PlayMap -> Maybe PlayState
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (a -> String
forall a. Show a => a -> String
show a
k) PlayMap
pMap
                MVar PlayMap -> PlayMap -> IO ()
forall a. MVar a -> a -> IO ()
putMVar (Stream -> MVar PlayMap
sPMapMV Stream
s) (PlayMap -> IO ()) -> PlayMap -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> PlayState -> PlayMap -> PlayMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (a -> String
forall a. Show a => a -> String
show a
k) PlayState
playState PlayMap
pMap
                () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          )
    (\(SomeException
e :: E.SomeException) -> Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"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) = 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 Maybe PlayState
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 Stream
s a
k = Stream -> String -> (PlayState -> PlayState) -> IO ()
withPatId Stream
s (a -> String
forall a. Show a => a -> String
show a
k) (\PlayState
x -> PlayState
x {mute :: Bool
mute = Bool
True})

streamMutes :: Show a => Stream -> [a] -> IO ()
streamMutes :: Stream -> [a] -> IO ()
streamMutes Stream
s [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) (\PlayState
x -> PlayState
x {mute :: Bool
mute = Bool
True})

streamUnmute :: Show a => Stream -> a -> IO ()
streamUnmute :: Stream -> a -> IO ()
streamUnmute Stream
s a
k = Stream -> String -> (PlayState -> PlayState) -> IO ()
withPatId Stream
s (a -> String
forall a. Show a => a -> String
show a
k) (\PlayState
x -> PlayState
x {mute :: Bool
mute = Bool
False})

streamSolo :: Show a => Stream -> a -> IO ()
streamSolo :: Stream -> a -> IO ()
streamSolo Stream
s a
k = Stream -> String -> (PlayState -> PlayState) -> IO ()
withPatId Stream
s (a -> String
forall a. Show a => a -> String
show a
k) (\PlayState
x -> PlayState
x {solo :: Bool
solo = Bool
True})

streamUnsolo :: Show a => Stream -> a -> IO ()
streamUnsolo :: Stream -> a -> IO ()
streamUnsolo Stream
s a
k = Stream -> String -> (PlayState -> PlayState) -> IO ()
withPatId Stream
s (a -> String
forall a. Show a => a -> String
show a
k) (\PlayState
x -> PlayState
x {solo :: Bool
solo = Bool
False})

withPatId :: Stream -> PatId -> (PlayState -> PlayState) -> IO ()
withPatId :: Stream -> String -> (PlayState -> PlayState) -> IO ()
withPatId Stream
s String
k 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 Stream
s [String]
ks 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 (\PlayState
x -> PlayState -> Maybe PlayState
forall a. a -> Maybe a
Just (PlayState -> Maybe PlayState) -> PlayState -> Maybe PlayState
forall a b. (a -> b) -> a -> b
$ PlayState -> PlayState
f PlayState
x)) PlayMap
playMap [String]
ks
       MVar PlayMap -> PlayMap -> IO ()
forall a. MVar a -> a -> IO ()
putMVar (Stream -> MVar PlayMap
sPMapMV Stream
s) PlayMap
pMap'
       () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- TODO - is there a race condition here?
streamMuteAll :: Stream -> IO ()
streamMuteAll :: Stream -> IO ()
streamMuteAll Stream
s = MVar PlayMap -> (PlayMap -> IO PlayMap) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (Stream -> MVar PlayMap
sPMapMV Stream
s) ((PlayMap -> IO PlayMap) -> IO ())
-> (PlayMap -> IO PlayMap) -> IO ()
forall a b. (a -> b) -> a -> b
$ PlayMap -> IO PlayMap
forall (m :: * -> *) a. Monad m => a -> m a
return (PlayMap -> IO PlayMap)
-> (PlayMap -> PlayMap) -> PlayMap -> IO PlayMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PlayState -> PlayState) -> PlayMap -> PlayMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\PlayState
x -> PlayState
x {mute :: Bool
mute = Bool
True})

streamHush :: Stream -> IO ()
streamHush :: Stream -> IO ()
streamHush Stream
s = MVar PlayMap -> (PlayMap -> IO PlayMap) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (Stream -> MVar PlayMap
sPMapMV Stream
s) ((PlayMap -> IO PlayMap) -> IO ())
-> (PlayMap -> IO PlayMap) -> IO ()
forall a b. (a -> b) -> a -> b
$ PlayMap -> IO PlayMap
forall (m :: * -> *) a. Monad m => a -> m a
return (PlayMap -> IO PlayMap)
-> (PlayMap -> PlayMap) -> PlayMap -> IO PlayMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PlayState -> PlayState) -> PlayMap -> PlayMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\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 Stream
s = MVar PlayMap -> (PlayMap -> IO PlayMap) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (Stream -> MVar PlayMap
sPMapMV Stream
s) ((PlayMap -> IO PlayMap) -> IO ())
-> (PlayMap -> IO PlayMap) -> IO ()
forall a b. (a -> b) -> a -> b
$ PlayMap -> IO PlayMap
forall (m :: * -> *) a. Monad m => a -> m a
return (PlayMap -> IO PlayMap)
-> (PlayMap -> PlayMap) -> PlayMap -> IO PlayMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PlayState -> PlayState) -> PlayMap -> PlayMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\PlayState
x -> PlayState
x {mute :: Bool
mute = Bool
False})

streamAll :: Stream -> (ControlPattern -> ControlPattern) -> IO ()
streamAll :: Stream -> (ControlPattern -> ControlPattern) -> IO ()
streamAll Stream
s ControlPattern -> ControlPattern
f = do ControlPattern -> ControlPattern
_ <- MVar (ControlPattern -> ControlPattern)
-> (ControlPattern -> ControlPattern)
-> IO (ControlPattern -> ControlPattern)
forall a. MVar a -> a -> IO a
swapMVar (Stream -> MVar (ControlPattern -> ControlPattern)
sGlobalFMV Stream
s) ControlPattern -> ControlPattern
f
                   () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

streamSet :: Valuable a => Stream -> String -> Pattern a -> IO ()
streamSet :: Stream -> String -> Pattern a -> IO ()
streamSet Stream
s String
k Pattern a
pat = do ValueMap
sMap <- MVar ValueMap -> IO ValueMap
forall a. MVar a -> IO a
takeMVar (MVar ValueMap -> IO ValueMap) -> MVar ValueMap -> IO ValueMap
forall a b. (a -> b) -> a -> b
$ Stream -> MVar ValueMap
sStateMV 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' :: ValueMap
sMap' = String -> Value -> ValueMap -> ValueMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
k (Pattern Value -> Value
VPattern Pattern Value
pat') ValueMap
sMap
                       MVar ValueMap -> ValueMap -> IO ()
forall a. MVar a -> a -> IO ()
putMVar (Stream -> MVar ValueMap
sStateMV Stream
s) (ValueMap -> IO ()) -> ValueMap -> IO ()
forall a b. (a -> b) -> a -> b
$ ValueMap
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

openListener :: Config -> IO (Maybe O.UDP)
openListener :: Config -> IO (Maybe UDP)
openListener Config
c
  | Config -> Bool
cCtrlListen Config
c = IO (Maybe UDP)
-> (SomeException -> IO (Maybe UDP)) -> IO (Maybe UDP)
forall a. IO a -> (SomeException -> IO a) -> IO a
catchAny IO (Maybe UDP)
run (\SomeException
_ -> do Config -> String -> IO ()
verbose Config
c String
"That port isn't available, perhaps another Tidal instance is already listening on that port?"
                                           Maybe UDP -> IO (Maybe UDP)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe UDP
forall a. Maybe a
Nothing
                                 )
  | Bool
otherwise  = Maybe UDP -> IO (Maybe UDP)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe UDP
forall a. Maybe a
Nothing
  where
        run :: IO (Maybe UDP)
run = do UDP
sock <- String -> Int -> IO UDP
O.udpServer (Config -> String
cCtrlAddr Config
c) (Config -> Int
cCtrlPort Config
c)
                 Maybe UDP -> IO (Maybe UDP)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe UDP -> IO (Maybe UDP)) -> Maybe UDP -> IO (Maybe UDP)
forall a b. (a -> b) -> a -> b
$ UDP -> Maybe UDP
forall a. a -> Maybe a
Just UDP
sock
        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

ctrlResponder :: Int -> Config -> Stream -> IO ()
ctrlResponder :: Int -> Config -> Stream -> IO ()
ctrlResponder Int
waits Config
c (stream :: Stream
stream@(Stream {sListen :: Stream -> Maybe UDP
sListen = Just UDP
sock}))
  = do [Message]
ms <- Double -> UDP -> IO [Message]
forall t. Transport t => Double -> t -> IO [Message]
recvMessagesTimeout Double
2 UDP
sock
       if ([Message] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Message]
ms)
         then do IO ()
checkHandshake -- there was a timeout, check handshake
                 Int -> Config -> Stream -> IO ()
ctrlResponder (Int
waitsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Config
c Stream
stream
         else do (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
                 Int -> Config -> Stream -> IO ()
ctrlResponder Int
0 Config
c Stream
stream
     where
        checkHandshake :: IO ()
checkHandshake = do [Int]
busses <- MVar [Int] -> IO [Int]
forall a. MVar a -> IO a
readMVar (Stream -> MVar [Int]
sBusses Stream
stream)
                            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
busses) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when  (Int
waits Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Config -> String -> IO ()
verbose Config
c (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Waiting for SuperDirt (v.1.7.2 or higher).."
                                                    Stream -> IO ()
sendHandshakes Stream
stream

        act :: Message -> IO ()
act (O.Message String
"/dirt/hello" [Datum]
_) = Stream -> IO ()
sendHandshakes Stream
stream
        act (O.Message String
"/dirt/handshake/reply" [Datum]
xs) = do [Int]
prev <- MVar [Int] -> [Int] -> IO [Int]
forall a. MVar a -> a -> IO a
swapMVar (Stream -> MVar [Int]
sBusses Stream
stream) ([Int] -> IO [Int]) -> [Int] -> IO [Int]
forall a b. (a -> b) -> a -> b
$ [Datum] -> [Int]
forall a. Integral a => [Datum] -> [a]
bufferIndices [Datum]
xs
                                                        -- Only report the first time..
                                                        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
prev) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Config -> String -> IO ()
verbose Config
c (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Connected to SuperDirt."
                                                        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          where 
            bufferIndices :: [Datum] -> [a]
bufferIndices [] = []
            bufferIndices (Datum
x:[Datum]
xs') | Datum
x Datum -> Datum -> Bool
forall a. Eq a => a -> a -> Bool
== (ASCII -> Datum
O.ASCII_String (ASCII -> Datum) -> ASCII -> Datum
forall a b. (a -> b) -> a -> b
$ String -> ASCII
O.ascii String
"&controlBusIndices") = [Maybe a] -> [a]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe a] -> [a]) -> [Maybe a] -> [a]
forall a b. (a -> b) -> a -> b
$ (Maybe a -> Bool) -> [Maybe a] -> [Maybe a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Maybe a -> Bool
forall a. Maybe a -> Bool
isJust ([Maybe a] -> [Maybe a]) -> [Maybe a] -> [Maybe a]
forall a b. (a -> b) -> a -> b
$ (Datum -> Maybe a) -> [Datum] -> [Maybe a]
forall a b. (a -> b) -> [a] -> [b]
map Datum -> Maybe a
forall i. Integral i => Datum -> Maybe i
O.datum_integral [Datum]
xs'
                                  | Bool
otherwise = [Datum] -> [a]
bufferIndices [Datum]
xs'
        act (O.Message String
x (O.Int32 Int32
k: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 String
_ (O.ASCII_String ASCII
k:v :: Datum
v@(O.Float Float
_):[]))
          = String -> Value -> IO ()
add (ASCII -> String
O.ascii_to_string ASCII
k) (Double -> Value
VF (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 String
_ (O.ASCII_String ASCII
k:O.ASCII_String ASCII
v:[]))
          = String -> Value -> IO ()
add (ASCII -> String
O.ascii_to_string ASCII
k) (String -> Value
VS (ASCII -> String
O.ascii_to_string ASCII
v))
        act (O.Message String
_ (O.ASCII_String ASCII
k:O.Int32 Int32
v:[]))
          = String -> Value -> IO ()
add (ASCII -> String
O.ascii_to_string ASCII
k) (Int -> Value
VI (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
v))
        act Message
m = Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"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 String
k Value
v = do ValueMap
sMap <- MVar ValueMap -> IO ValueMap
forall a. MVar a -> IO a
takeMVar (Stream -> MVar ValueMap
sStateMV Stream
stream)
                     MVar ValueMap -> ValueMap -> IO ()
forall a. MVar a -> a -> IO ()
putMVar (Stream -> MVar ValueMap
sStateMV Stream
stream) (ValueMap -> IO ()) -> ValueMap -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Value -> ValueMap -> ValueMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
k Value
v ValueMap
sMap
                     () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
ctrlResponder Int
_ Config
_ Stream
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()


verbose :: Config -> String -> IO ()
verbose :: Config -> String -> IO ()
verbose Config
c String
s = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Config -> Bool
cVerbose Config
c) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
s

recvMessagesTimeout :: (O.Transport t) => Double -> t -> IO [O.Message]
recvMessagesTimeout :: Double -> t -> IO [Message]
recvMessagesTimeout Double
n t
sock = (Maybe Packet -> [Message]) -> IO (Maybe Packet) -> IO [Message]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Message] -> (Packet -> [Message]) -> Maybe Packet -> [Message]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Packet -> [Message]
O.packetMessages) (IO (Maybe Packet) -> IO [Message])
-> IO (Maybe Packet) -> IO [Message]
forall a b. (a -> b) -> a -> b
$ Double -> t -> IO (Maybe Packet)
forall t. Transport t => Double -> t -> IO (Maybe Packet)
O.recvPacketTimeout Double
n t
sock


streamGetcps :: Stream -> IO O.Time
streamGetcps :: Stream -> IO Double
streamGetcps Stream
s = do 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
                    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> IO Double) -> Double -> IO Double
forall a b. (a -> b) -> a -> b
$ Tempo -> Double
T.cps Tempo
tempo

streamGetnow :: Stream -> IO Double
streamGetnow :: Stream -> IO Double
streamGetnow Stream
s = do 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
                    Double
now <- IO Double
forall (m :: * -> *). MonadIO m => m Double
O.time
                    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> IO Double) -> Double -> IO Double
forall a b. (a -> b) -> a -> b
$ Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Rational -> Double) -> Rational -> Double
forall a b. (a -> b) -> a -> b
$ Tempo -> Double -> Rational
T.timeToCycles Tempo
tempo Double
now