module Sound.Tidal.OscStream where
import qualified Data.Map as Map
import Data.Maybe
import Sound.Tidal.Tempo (Tempo, cps)
import Sound.Tidal.Stream
import Sound.Tidal.Utils
import GHC.Float (float2Double, double2Float)
import Sound.OSC.FD
import Sound.OSC.Datum
import Sound.Tidal.Params
data TimeStamp = BundleStamp | MessageStamp | NoStamp
deriving Eq
data OscSlang = OscSlang {path :: String,
timestamp :: TimeStamp,
namedParams :: Bool,
preamble :: [Datum]
}
type OscMap = Map.Map Param Datum
toOscDatum :: Value -> Datum
toOscDatum (VF x) = float x
toOscDatum (VI x) = int32 x
toOscDatum (VS x) = string x
toOscMap :: ParamMap -> OscMap
toOscMap m = Map.map (toOscDatum) m
send
:: (Integral a) =>
UDP
-> OscSlang
-> Shape
-> Tempo
-> a
-> (Double,
Double,
OscMap)
-> IO ()
send s slang shape change tick (on, off, m) = osc
where
osc | timestamp slang == BundleStamp =
sendOSC s $ Bundle (ut_to_ntpr logicalOnset) [Message (path slang) oscdata]
| timestamp slang == MessageStamp =
sendOSC s $ Message (path slang) ((int32 sec):(int32 usec):oscdata)
| otherwise =
doAt logicalOnset $ sendOSC s $ Message (path slang) oscdata
oscPreamble = cpsPrefix ++ preamble slang
oscdata | namedParams slang = oscPreamble ++ (concatMap (\(k, v) -> [string (name k), v] )
$ Map.assocs m)
| otherwise = oscPreamble ++ (catMaybes $ map (\x -> Map.lookup x m) (params shape))
cpsPrefix | cpsStamp shape && namedParams slang = [string "cps",
float (cps change),
string "delta",
float (logicalOffset
logicalOnset),
string "cycle", float cycle
]
| cpsStamp shape = [float (cps change)]
| otherwise = []
cycle = (on + fromIntegral tick) / (fromIntegral ticksPerCycle)
_parameterise ds = mergelists (map (string . name) (params shape)) ds
usec = floor $ 1000000 * (logicalOnset (fromIntegral sec))
sec = floor logicalOnset
logicalOnset = logicalOnset' change tick on ((latency shape) + nudge)
logicalOffset = logicalOnset' change tick off ((latency shape) + nudge)
nudge = maybe 0 (toF) (Map.lookup nudge_p (m :: OscMap))
toF (Float f) = float2Double f
toF _ = 0
makeConnection :: String -> Int -> OscSlang -> IO (ToMessageFunc)
makeConnection address port slang = do
s <- openUDP address port
return (\ shape change tick (on,off,m) -> do
let m' = if (namedParams slang) then (Just m) else (applyShape' shape m)
m'' <- fmap (toOscMap) m'
return $ send s slang shape change tick (on,off,m'')
)