tidal-midi 0.0.2 → 0.1
raw patch · 7 files changed
+177/−124 lines, 7 files
Files
- Sound/Tidal/MBase01.hs +34/−0
- Sound/Tidal/MIDI/Control.hs +8/−2
- Sound/Tidal/MIDI/Device.hs +4/−9
- Sound/Tidal/MIDI/Output.hs +41/−26
- Sound/Tidal/Tetra.hs +85/−83
- Sound/Tidal/VolcaBass.hs +2/−2
- tidal-midi.cabal +3/−2
+ Sound/Tidal/MBase01.hs view
@@ -0,0 +1,34 @@+module Sound.Tidal.MBase01 where+import Sound.Tidal.Stream (makeI, makeF)++import Sound.Tidal.MIDI.Control++mbase01 :: ControllerShape+mbase01 = ControllerShape {params = [+ mCC "tune" 100,+ mCC "pitch" 101,+ mCC "decay" 102,+ mCC "harmonics" 103,+ mCC "pulse" 104,+ mCC "noise" 105,+ mCC "attack" 106,+ mCC "eqlzr" 107+ ],+ duration = ("dur", 0.05),+ velocity = ("vel", 0.5),+ latency = 0.1}++oscKeys = toOscShape mbase01++note = makeI oscKeys "note"+dur = makeF oscKeys "dur"+++tune = makeF oscKeys "tune"+pitch = makeF oscKeys "pitch"+decay = makeF oscKeys "decay"+harmonics = makeF oscKeys "harmonics"+pulse = makeF oscKeys "pulse"+noise = makeF oscKeys "noise"+attack = makeF oscKeys "attack"+eqlzr = makeF oscKeys "eqlzr"
Sound/Tidal/MIDI/Control.hs view
@@ -2,7 +2,6 @@ import qualified Sound.Tidal.Stream as S - type RangeMapFunc = (Int, Int) -> Float -> Int data Param = CC { name :: String, midi :: Int, range :: (Int, Int), vdefault :: Double, scalef :: RangeMapFunc }@@ -33,15 +32,22 @@ mapRange (low, high) = floor . (+ (fromIntegral low)) . (* ratio) where ratio = fromIntegral $ high - low -+mCC :: String -> Int -> Param mCC n m = CC {name=n, midi=m, range=(0, 127), vdefault=0, scalef=mapRange }++mNRPN :: String -> Int -> Param mNRPN n m = NRPN {name=n, midi=m, range=(0, 127), vdefault=0, scalef=mapRange }++mrNRPN :: String -> Int -> (Int, Int) -> Double -> Param mrNRPN n m r d = NRPN {name=n, midi=m, range=r, vdefault=d, scalef=mapRange }+ toKeynames :: ControllerShape -> [String] toKeynames shape = map name (params shape) +ctrlN :: Num b => ControllerShape -> String -> b ctrlN shape x = fromIntegral $ midi $ paramN shape x +paramN :: ControllerShape -> String -> Param paramN shape x | x `elem` names = paramX x | otherwise = error $ "No such Controller param: " ++ show x
Sound/Tidal/MIDI/Device.hs view
@@ -1,11 +1,7 @@ module Sound.Tidal.MIDI.Device where import qualified Sound.PortMidi as PM-import Control.Exception-import Data.List ----withPortMidi = bracket_ PM.initialize PM.terminate-+displayOutputDevices :: IO String displayOutputDevices = do devices <- getIndexedDevices return $ displayDevices $ getOutputDevices devices@@ -17,8 +13,10 @@ pairs = zipWith (++) indices names in unlines (["ID:\tName"]++pairs) +getOutputDevices :: [(a, PM.DeviceInfo)] -> [(a, PM.DeviceInfo)] getOutputDevices = filter (PM.output . snd) +getIndexedDevices :: IO [(Integer, PM.DeviceInfo)] getIndexedDevices = do rawDevices <- getDevices return $ zip [0..] rawDevices@@ -29,13 +27,10 @@ count <- PM.countDevices mapM PM.getDeviceInfo [0..(count - 1)] -+getIDForDeviceName :: Num a => String -> IO (Maybe a) getIDForDeviceName name = do odevs <- fmap getOutputDevices getIndexedDevices let res = filter (\n -> (PM.name . snd) n == name) odevs case res of [] -> return Nothing [dev] -> return $ Just $ fromIntegral $ fst dev----main = do--- putStrLn =<< displayOutputDevices
Sound/Tidal/MIDI/Output.hs view
@@ -1,4 +1,4 @@-module Sound.Tidal.MIDI.Output where+module Sound.Tidal.MIDI.Output (midiproxy) where import qualified Sound.PortMidi as PM @@ -9,11 +9,7 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC -import Numeric- import Sound.OSC.FD-- import Control.Monad import Control.Concurrent.MVar @@ -22,6 +18,7 @@ import Data.List (sortBy) import Data.Maybe import Data.Ord (comparing)+import Data.Word (Word8) import Control.Concurrent import Foreign.C@@ -29,9 +26,8 @@ import qualified Sound.Tidal.MIDI.Control as C import Sound.Tidal.Pattern-import Sound.Tidal.Parse import Sound.Tidal.Tempo-import qualified Sound.Tidal.Stream as S (stream, name, params)+import qualified Sound.Tidal.Stream as S (stream, name, params, OscPattern, OscShape) import System.IO.Error @@ -41,7 +37,24 @@ offset :: (Int, Int), buffer :: MVar [PM.PMEvent] }+midiproxy :: Int -> String-> [(C.ControllerShape, Int)] -> IO [IO (S.OscPattern -> IO ())]+midiproxy latency deviceName targets = do+ let keyStreams = map (\(shape, channel) -> makeStream (C.toOscShape shape) (channel + 7303)) targets+ deviceID <- getIDForDeviceName deviceName+ case deviceID of+ Nothing -> do putStrLn "List of Available Device Names"+ putStrLn =<< displayOutputDevices+ error ("Device '" ++ show deviceName ++ "' not found")+ Just id -> do econn <- outputDevice id latency+ case econn of+ Right err -> error ("Failed opening MIDI Output on Device ID: " ++ show deviceID ++ " - " ++ show err)+ Left conn -> do+ sendevents conn+ --midiclock conn+ mapM_ (\(shape,channel) -> messageLoop conn shape (fromIntegral channel) (channel + 7303)) targets+ return keyStreams +messageLoop :: Output -> C.ControllerShape -> CLong -> Int -> IO ThreadId messageLoop stream shape ch port = do putStrLn ("Starting message loop on port " ++ show port ++ " for MIDI channel " ++ show ch) x <- udpServer "127.0.0.1" port@@ -62,24 +75,11 @@ -- putStrLn ("MIDI in: " ++ (show (diff - mTime))) sendmidi stream shape ch (fromIntegral note', fromIntegral $ C.mapRange (0, 127) (realToFrac vel'), realToFrac dur') (diff) ctrls' return()-makeStream shape port = S.stream "127.0.0.1" port shape -keyproxy latency deviceName targets = do- let keyStreams = map (\(shape, channel) -> makeStream (C.toOscShape shape) (channel + 7303)) targets- deviceID <- getIDForDeviceName deviceName- case deviceID of- Nothing -> do putStrLn "List of Available Device Names"- putStrLn =<< displayOutputDevices- error ("Device '" ++ show deviceName ++ "' not found")- Just id -> do econn <- outputDevice id latency- case econn of- Right err -> error ("Failed opening MIDI Output on Device ID: " ++ show deviceID ++ " - " ++ show err)- Left conn -> do- sendevents conn- midiclock conn- mapM_ (\(shape,channel) -> messageLoop conn shape (fromIntegral channel) (channel + 7303)) targets- return keyStreams+makeStream :: S.OscShape -> Int -> IO (S.OscPattern -> IO ())+makeStream shape port = S.stream "127.0.0.1" port shape +-- EXPERIMENTAL midiclock stream = do forkIO $ do clockedTick 1 $ onClockTick stream @@ -90,8 +90,9 @@ time <- PM.time mapM_ (makeMidiClockTick stream) (map ((+time).round.(/(24*(cps current))).(*1000)) [0..23]) return ()-+-- END EXPERIMENTAL +sendevents :: Output -> IO ThreadId sendevents stream = do forkIO $ do loop stream where loop stream = do act stream@@ -121,17 +122,19 @@ delay = threadDelay 1000 -- in microseconds, i.e. one millisecond -+sendctrls :: Output -> C.ControllerShape -> CLong -> CULong -> [Float] -> IO () sendctrls stream shape ch t ctrls = do let ctrls' = filter ((>=0) . snd) (zip (C.toKeynames shape) ctrls) sequence_ $ map (\(name, ctrl) -> makeCtrl stream ch (C.paramN shape name) ctrl t) ctrls' return () +sendnote :: RealFrac s => Output -> t -> CLong -> (CLong, CLong, s) -> CULong -> IO ThreadId sendnote stream shape ch (note,vel, dur) t = do forkIO $ do noteOn stream ch note vel t noteOff stream ch note (t + (floor $ 1000 * dur)) return () +sendmidi :: RealFrac s => Output -> C.ControllerShape -> CLong -> (CLong, CLong, s) -> CULong -> [Float] -> IO () sendmidi stream shape ch (128,vel,dur) t ctrls = do sendctrls stream shape ch t ctrls return ()@@ -140,6 +143,7 @@ sendctrls stream shape ch t ctrls return () +timeDiff :: (Integral b, Integral a1, Integral a) => (Datum, Datum) -> (a, a1) -> b timeDiff (ds, du) (s, u) = diff d i where diff a b = floor ((a - b) * 1000) -- as millis d = asFrac jds jdu@@ -150,17 +154,22 @@ -- MIDI Utils+encodeChannel :: (Bits a, Num a) => a -> a -> a encodeChannel ch cc = (((-) ch 1) .|. cc) + -- MIDI Messages+noteOn :: Output -> CLong -> CLong -> CLong -> CULong -> IO (Maybe a) noteOn o ch val vel t = do let evt = makeEvent 0x90 val ch vel t sendEvent o evt +noteOff :: Output -> CLong -> CLong -> CULong -> IO (Maybe a) noteOff o ch val t = do let evt = makeEvent 0x80 val ch 60 t sendEvent o evt +makeCtrl :: Output -> CLong -> C.Param -> Float -> CULong -> IO (Maybe a) makeCtrl o ch (C.CC {C.midi=midi, C.range=range, C.scalef=f}) n t = makeCC o ch (fromIntegral midi) scaledN t where scaledN = fromIntegral (f range (n)) makeCtrl o ch (C.NRPN {C.midi=midi, C.range=range, C.scalef=f}) n t = makeNRPN o ch (fromIntegral midi) scaledN t@@ -168,13 +177,14 @@ makeCtrl o ch (C.SysEx {C.midi=midi, C.range=range, C.scalef=f}) n t = makeSysEx o ch (fromIntegral midi) scaledN t where scaledN = fromIntegral $ (f range (n)) - -- This is sending CC+makeCC :: Output -> CLong -> CLong -> CLong -> CULong -> IO (Maybe a) makeCC o ch c n t = do let evt = makeEvent 0xB0 c ch n t sendEvent o evt -- This is sending NRPN+makeNRPN :: Output -> CLong -> CLong -> CLong -> CULong -> IO (Maybe a) makeNRPN o ch c n t = do let nrpn = makeEvent 0xB0 evts = [nrpn 0x63 ch (shift (c .&. 0x3F80) (-7)) t,@@ -188,6 +198,7 @@ makeMidiClockTick o t = do sendEvent o $ PM.PMEvent (PM.PMMsg 0xF8 0x00 0x00) t +makeSysEx :: Output -> t -> Word8 -> Word8 -> CULong -> IO (Maybe a) makeSysEx o ch c n t = do let bytes = [0xF0, -- SysEx Start 0x3E, -- Vendor ID@@ -207,6 +218,7 @@ -- PortMIDI Wrapper +outputDevice :: PM.DeviceID -> Int -> IO (Either Output PM.PMError) outputDevice deviceID latency = do PM.initialize now <- getCurrentTime@@ -229,9 +241,11 @@ return (Left Output { conn=dev, lock=sem, offset=(sec, usec), buffer=buffer }) Right err -> return (Right err) +makeEvent :: CLong -> CLong -> CLong -> CLong -> CULong -> PM.PMEvent makeEvent st n ch v t = PM.PMEvent msg (t) where msg = PM.PMMsg (encodeChannel ch st) (n) (v) +sendSysEx :: Output -> CULong -> String -> IO (Maybe a) sendSysEx o t msg = do let sem = lock o takeMVar sem@@ -240,6 +254,7 @@ return Nothing -- now with a semaphore since PortMIDI is NOT thread safe+sendEvent :: Output -> PM.PMEvent -> IO (Maybe a) sendEvent o evt = do let sem = lock o buf = buffer o
Sound/Tidal/Tetra.hs view
@@ -395,114 +395,116 @@ -- lfo -lfotri = 0-lforsaw = 1-lfosaw = 2-lfopulse = 3-lforand = 4+lfotri = doublePattern 0+lforsaw = doublePattern 1+lfosaw = doublePattern 2+lfopulse = doublePattern 3+lforand = doublePattern 4 lrate r = ((min 150) . (max 0)) <$> p r lstep s = ((min 166) . (max 151) . (+150)) <$> p s -lfo1 s d r a = lfo1shape s |+| lfo1dest (p $ show d) |+| lfo1rate r |+| lfo1amt a-lfo2 s d r a = lfo2shape s |+| lfo2dest (p $ show d) |+| lfo2rate r |+| lfo2amt a-lfo3 s d r a = lfo3shape s |+| lfo3dest (p $ show d) |+| lfo3rate r |+| lfo3amt a-lfo4 s d r a = lfo4shape s |+| lfo4dest (p $ show d) |+| lfo4rate r |+| lfo4amt a+lfo1 s d r a = lfo1shape s |+| lfo1dest d |+| lfo1rate r |+| lfo1amt a+lfo2 s d r a = lfo2shape s |+| lfo2dest d |+| lfo2rate r |+| lfo2amt a+lfo3 s d r a = lfo3shape s |+| lfo3dest d |+| lfo3rate r |+| lfo3amt a+lfo4 s d r a = lfo4shape s |+| lfo4dest d |+| lfo4rate r |+| lfo4amt a --lfo = lfo1 -- mod -mod1 s d a = mod1src (p $ show s) |+| mod1dst (p $ show d) |+| mod1amt a-mod2 s d a = mod2src (p $ show s) |+| mod2dst (p $ show d) |+| mod2amt a-mod3 s d a = mod3src (p $ show s) |+| mod3dst (p $ show d) |+| mod3amt a-mod4 s d a = mod4src (p $ show s) |+| mod4dst (p $ show d) |+| mod4amt a+mod1 s d a = mod1src s |+| mod1dst d |+| mod1amt a+mod2 s d a = mod2src s |+| mod2dst d |+| mod2amt a+mod3 s d a = mod3src s |+| mod3dst d |+| mod3amt a+mod4 s d a = mod4src s |+| mod4dst d |+| mod4amt a -- mod destination -dosc1 = 1-dosc2 = 2-dosc = 3-dmix = 4-dnoise = 5-dpw1 = 6-dpw2 = 7-dpw = 8-dcut = 9-dres = 10-damod = 11-dvca = 12-dspread = 13+doublePattern d = (p $ show d) :: Pattern Double -dlfo1f = 14-dlfo2f = 15-dlfo3f = 16-dlfo4f = 17-dlfof = 18+dosc1 = doublePattern 1+dosc2 = doublePattern 2+dosc = doublePattern 3+dmix = doublePattern 4+dnoise = doublePattern 5+dpw1 = doublePattern 6+dpw2 = doublePattern 7+dpw = doublePattern 8+dcut = doublePattern 9+dres = doublePattern 10+damod = doublePattern 11+dvca = doublePattern 12+dspread = doublePattern 13 -dlfo1a = 19-dlfo2a = 20-dlfo3a = 21-dlfo4a = 22-dlfoa = 23+dlfo1f = doublePattern 14+dlfo2f = doublePattern 15+dlfo3f = doublePattern 16+dlfo4f = doublePattern 17+dlfof = doublePattern 18 -dfamt = 24-dvamt = 25-deamt = 26-damt = 27+dlfo1a = doublePattern 19+dlfo2a = doublePattern 20+dlfo3a = doublePattern 21+dlfo4a = doublePattern 22+dlfoa = doublePattern 23 -dfatk = 28-dvatk = 29-deatk = 30-datk = 31+dfamt = doublePattern 24+dvamt = doublePattern 25+deamt = doublePattern 26+damt = doublePattern 27 -dfdcy = 32-dvdcy = 33-dedcy = 34-ddcy = 35+dfatk = doublePattern 28+dvatk = doublePattern 29+deatk = doublePattern 30+datk = doublePattern 31 -dfrel = 36-dvrel = 37-derel = 38-drel = 39+dfdcy = doublePattern 32+dvdcy = doublePattern 33+dedcy = doublePattern 34+ddcy = doublePattern 35 -dmod1 = 40-dmod2 = 41-dmod3 = 42-dmod4 = 43+dfrel = doublePattern 36+dvrel = doublePattern 37+derel = doublePattern 38+drel = doublePattern 39 -dfb = 44-dsub1 = 45-dsub2 = 46-dfbgain = 47-dslew = 48+dmod1 = doublePattern 40+dmod2 = doublePattern 41+dmod3 = doublePattern 42+dmod4 = doublePattern 43 +dfb = doublePattern 44+dsub1 = doublePattern 45+dsub2 = doublePattern 46+dfbgain = doublePattern 47+dslew = doublePattern 48+ -- mod sources -sseq1 = 1-sseq2 = 2-sseq3 = 3-sseq4 = 4+sseq1 = doublePattern 1+sseq2 = doublePattern 2+sseq3 = doublePattern 3+sseq4 = doublePattern 4 -slfo1 = 5-slfo2 = 6-slfo3 = 7-slfo4 = 8+slfo1 = doublePattern 5+slfo2 = doublePattern 6+slfo3 = doublePattern 7+slfo4 = doublePattern 8 -sfenv = 9-svenv = 10-seenv = 11+sfenv = doublePattern 9+svenv = doublePattern 10+seenv = doublePattern 11 -spitchb = 12-smodwh = 13-saftert = 14-sbreath = 15-sfoot = 16-sexpr = 17+spitchb = doublePattern 12+smodwh = doublePattern 13+saftert = doublePattern 14+sbreath = doublePattern 15+sfoot = doublePattern 16+sexpr = doublePattern 17 -svel = 18-snote = 19-snoise = 20+svel = doublePattern 18+snote = doublePattern 19+snoise = doublePattern 20 -- drums @@ -510,9 +512,9 @@ |+| osc1shape zero |+| osc1kbd zero |+| osc2shape zero |+| osc2kbd zero |+| noise one- |+| vrel zero |+| vsus zero |+| vdcy d+ |+| vrel d |+| vsus zero |+| vdcy d |+| kcutoff (p "1")- |+| dur d+ |+| dur (p "0.01") where zero = p "0" one = p "1"
Sound/Tidal/VolcaBass.hs view
@@ -16,7 +16,7 @@ mCC "pitch3" 45, mCC "attack" 46, mCC "decay" 47,- mCC "cutoff" 48,+ mCC "cutoffegint" 48, mCC "gate" 49 ], duration = ("dur", 0.05),@@ -38,5 +38,5 @@ pitch3 = makeF oscBass "pitch3" attack = makeF oscBass "attack" decay = makeF oscBass "decay"-cutoff = makeF oscBass "cutoff"+cutoffegint = makeF oscBass "cutoffegint" gate = makeF oscBass "gate"
tidal-midi.cabal view
@@ -1,5 +1,5 @@ name: tidal-midi-version: 0.0.2+version: 0.1 synopsis: MIDI support for tidal -- description: homepage: http://tidal.lurk.org/@@ -13,7 +13,7 @@ build-type: Simple cabal-version: >=1.4 -Description: Initial MIDI support for Tidal. Currently only supports Volca Keys and Bass synths, and interface is likely to change significantly.+Description: MIDI support for Tidal. Supports Volca Keys, Bass and Beats and other synths. Interface is likely to change significantly. library Exposed-modules: Sound.Tidal.MIDI.Output@@ -27,5 +27,6 @@ Sound.Tidal.Tetra Sound.Tidal.Rytm Sound.Tidal.Synthino+ Sound.Tidal.MBase01 Build-depends: base < 5, tidal, PortMidi, process, hashable, containers, hosc, time, bytestring