diff --git a/Sound/Tidal/Blofeld.hs b/Sound/Tidal/Blofeld.hs deleted file mode 100644 --- a/Sound/Tidal/Blofeld.hs +++ /dev/null @@ -1,78 +0,0 @@ -module Sound.Tidal.Blofeld where - -import Sound.Tidal.Stream (makeI, makeF) - -import Sound.Tidal.MIDI.Control - -keys :: ControllerShape -keys = ControllerShape {params = [ - mCC "portamento" 5, - mCC "expression" 11, - CC "lfoshape" 15 (0, 5) 0 passThru, -- 0..5 - sine,triangle,square,saw,random,sample&hold - mCC "lforate" 16, - CC "lfosync" 17 (0, 1) 0 passThru, -- 0 off, 1 on - mCC "lfodelay" 18, - CC "octave" 27 (16, 112) 0 passThru, -- 16, 28, 40 .. 112 - 128' .. 1/2' - CC "semitone" 28 (52, 76) 0.5 passThru, -- 52 .. 76 - -12 - +12 semitones - mCC "detune" 29, - mCC "osc1fm" 30, - SysEx "osc1fmsrc" 6 (0, 11) 0 passThru, - CC "osc1shape" 31 (0, 5) 0 passThru, -- 0..5 - pulse, saw, tri, sine, alt 1, alt 2 - mCC "osc1pw" 33, - mCC "osc1pwm" 34, - SysEx "osc1pwmsrc" 10 (0, 30) 0 passThru, - mCC "osc1vol" 52, - mCC "osc1pan" 53, - mCC "ringmod" 54, - mCC "ringpan" 55, - mCC "noise" 60, - mCC "noisepan" 61, - mCC "noisecol" 62, - mCC "kcutoff" 69, - mCC "attack" 101, - mCC "decay" 102, - mCC "sustain" 103, - mCC "release" 106 - ], - duration = ("dur", 0.05), - velocity = ("vel", 0.5), - latency = 0.1} - -oscKeys = toOscShape keys - -note = makeI oscKeys "note" -dur = makeF oscKeys "dur" - -portamento = makeF oscKeys "portamento" -expression = makeF oscKeys "expression" -octave = makeF oscKeys "octave" -semitone = makeF oscKeys "semitone" -detune = makeF oscKeys "detune" - -kcutoff = makeF oscKeys "kcutoff" - -lforate = makeF oscKeys "lforate" -lfoshape = makeF oscKeys "lfoshape" -lfodelay = makeF oscKeys "lfodelay" -lfosync = makeF oscKeys "lfosyn" - -attack = makeF oscKeys "attack" -decay = makeF oscKeys "decay" -sustain = makeF oscKeys "sustain" -release = makeF oscKeys "release" - -osc1fm = makeF oscKeys "osc1fm" -osc1fmsrc = makeF oscKeys "osc1fmsrc" -osc1shape = makeF oscKeys "osc1shape" -osc1pw = makeF oscKeys "osc1pw" -osc1pwm = makeF oscKeys "osc1pwm" -osc1pwmsrc = makeF oscKeys "osc1pwmsrc" -osc1vol = makeF oscKeys "osc1vol" -osc1pan = makeF oscKeys "osc1pan" - -ringmod = makeF oscKeys "ringmod" -ringpan = makeF oscKeys "ringpan" - -noise = makeF oscKeys "noise" -noisepan = makeF oscKeys "noisepan" -noisecol = makeF oscKeys "noisecol" diff --git a/Sound/Tidal/MBase01.hs b/Sound/Tidal/MBase01.hs deleted file mode 100644 --- a/Sound/Tidal/MBase01.hs +++ /dev/null @@ -1,34 +0,0 @@ -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" diff --git a/Sound/Tidal/MIDI/Context.hs b/Sound/Tidal/MIDI/Context.hs new file mode 100644 --- /dev/null +++ b/Sound/Tidal/MIDI/Context.hs @@ -0,0 +1,6 @@ +module Sound.Tidal.MIDI.Context (module C) where + +import Sound.Tidal.MIDI.Device as C +import Sound.Tidal.MIDI.Control as C +import Sound.Tidal.MIDI.Stream as C +import Sound.Tidal.MIDI.Synth as C diff --git a/Sound/Tidal/MIDI/Control.hs b/Sound/Tidal/MIDI/Control.hs --- a/Sound/Tidal/MIDI/Control.hs +++ b/Sound/Tidal/MIDI/Control.hs @@ -2,56 +2,73 @@ import qualified Sound.Tidal.Stream as S -type RangeMapFunc = (Int, Int) -> Float -> Int +import Sound.Tidal.Params -data Param = CC { name :: String, midi :: Int, range :: (Int, Int), vdefault :: Double, scalef :: RangeMapFunc } - | NRPN { name :: String, midi :: Int, range :: (Int, Int), vdefault :: Double, scalef :: RangeMapFunc } - | SysEx { name :: String, midi :: Int, range :: (Int, Int), vdefault :: Double, scalef :: RangeMapFunc } +type RangeMapFunc = (Int, Int) -> Double -> Int -data ControllerShape = ControllerShape {params :: [Param],duration :: (String, Double), velocity :: (String, Double), latency :: Double} +data ControlChange = + CC { param :: S.Param, + midi :: Int, + range :: (Int, Int), + vdefault :: Double, + scalef :: RangeMapFunc + } + | NRPN { param :: S.Param, + midi :: Int, + range :: (Int, Int), + vdefault :: Double, + scalef :: RangeMapFunc + } + | SysEx { param :: S.Param, + midi :: Int, + range :: (Int, Int), + vdefault :: Double, + scalef :: RangeMapFunc + } -toOscShape :: ControllerShape -> S.OscShape -toOscShape cs = - let oscparams = [S.I "note" Nothing] ++ [S.F durn (Just durv), S.F veln (Just velv)] ++ oscparams' - oscparams' = [S.F (name p) (Just (-1)) | p <- (params cs)] - (durn, durv) = duration cs - (veln, velv) = velocity cs - in S.OscShape {S.path = "/note", - S.params = oscparams, - S.timestamp = S.MessageStamp, +data ControllerShape = ControllerShape { + controls :: [ControlChange], + latency :: Double + } + + +toShape :: ControllerShape -> S.Shape +toShape cs = + let params = [dur_p, n_p, velocity_p] ++ params' + params' = [param p | p <- (controls cs)] + in S.Shape { S.params = params, S.cpsStamp = False, - S.latency = latency cs, - S.namedParams = False, - S.preamble = [] - } + S.latency = latency cs + } -passThru :: (Int, Int) -> Float -> Int +passThru :: (Int, Int) -> Double -> Int passThru (_, _) = floor -- no sanitizing of range… -mapRange :: (Int, Int) -> Float -> Int +mapRange :: (Int, Int) -> Double -> Int 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 } +mCC :: S.Param -> Int -> ControlChange +mCC p m = CC {param=p, 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 } +mNRPN :: S.Param -> Int -> ControlChange +mNRPN p m = NRPN {param=p, 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 } +mrNRPN :: S.Param -> Int -> (Int, Int) -> Double -> ControlChange +mrNRPN p m r d = NRPN {param=p, midi=m, range=r, vdefault=d, scalef=mapRange } -toKeynames :: ControllerShape -> [String] -toKeynames shape = map name (params shape) +toParams :: ControllerShape -> [S.Param] +toParams shape = map param (controls shape) -ctrlN :: Num b => ControllerShape -> String -> b -ctrlN shape x = fromIntegral $ midi $ paramN shape x +ctrlN :: Num b => ControllerShape -> S.Param -> Maybe b +ctrlN shape x = fmap fromIntegral $ fmap midi (paramN shape x) -paramN :: ControllerShape -> String -> Param +paramN :: ControllerShape -> S.Param -> Maybe ControlChange paramN shape x - | x `elem` names = paramX x - | otherwise = error $ "No such Controller param: " ++ show x - where names = toKeynames shape - paramX x = head paramX' - paramX' = filter ((== x) . name) p - p = params shape + | x `elem` names = paramX $ matching p + | otherwise = Nothing -- error $ "No such Controller param: " ++ show x + where names = toParams shape + paramX [] = Nothing + paramX (h:_) = Just h + matching = filter ((== x) . param) + p = controls shape diff --git a/Sound/Tidal/MIDI/Output.hs b/Sound/Tidal/MIDI/Output.hs deleted file mode 100644 --- a/Sound/Tidal/MIDI/Output.hs +++ /dev/null @@ -1,263 +0,0 @@ -module Sound.Tidal.MIDI.Output (midiproxy) where - -import qualified Sound.PortMidi as PM - -import Sound.Tidal.MIDI.Device - -import Data.Time (getCurrentTime, UTCTime, diffUTCTime) -import Data.Time.Clock.POSIX -import qualified Data.ByteString as B -import qualified Data.ByteString.Char8 as BC - -import Sound.OSC.FD -import Control.Monad -import Control.Concurrent.MVar - -import Data.Bits -import Data.Char -import Data.List (sortBy) -import Data.Maybe -import Data.Ord (comparing) -import Data.Word (Word8) - -import Control.Concurrent -import Foreign.C - -import qualified Sound.Tidal.MIDI.Control as C - -import Sound.Tidal.Pattern -import Sound.Tidal.Tempo -import qualified Sound.Tidal.Stream as S (stream, name, params, OscPattern, OscShape) - -import System.IO.Error - -data Output = Output { - conn :: PM.PMStream, - lock :: MVar (), - 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 - - forkIO $ loop stream x ch - where loop stream x ch = do m <- recvMessage x - act stream m ch - loop stream x ch - act stream (Just (Message "/note" (sec:usec:note:dur:vel:ctrls))) ch = - do - let diff = timeDiff (sec, usec) (offset stream) - note' = (fromJust $ d_get note) :: Int - vel' = (fromJust $ d_get vel) :: Float - dur' = (fromJust $ d_get dur) :: Float - ctrls' = (map (fromJust . d_get) ctrls) :: [Float] - - -- mTime <- PM.time - -- 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 :: 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 - -onClockTick stream current ticks = do - -- schedule MIDI Clock Ticks ahead of time to avoid jumps in timing - -- e.g. if one tick per cycle - -- schedule 24 ticks ahead of time starting now with PM.time and incrementing each timestamp by ((1/cycle per seconds)/24)*1000 for ms for each tick - 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 - delay - loop stream - act stream = do - let buf = buffer stream - o = conn stream - buf' <- tryTakeMVar buf - case buf' of - Nothing -> do - return Nothing - Just [] -> do - putMVar buf [] - return Nothing - (Just evts@(x:xs)) -> do - midiTime <- PM.time - let evts' = sortBy (comparing PM.timestamp) evts - nextTick = fromIntegral $ midiTime + 1 -- advance on millisecond, i.e. the next call of this loop - (evts'',later) = span (\x -> (((PM.timestamp x) < midiTime)) || ((PM.timestamp x) < nextTick)) evts' - putMVar buf later - - err <- PM.writeEvents o evts'' - case err of - PM.NoError -> return Nothing - e -> return $ Just (userError ("Error '" ++ show e ++ "' sending Events: " ++ show evts)) - - 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 () -sendmidi stream shape ch (note,vel,dur) t ctrls = do - sendnote stream shape ch (note,vel,dur) t - 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 - i = asFrac s u - jds = (fromJust $ d_get ds) :: Int - jdu = (fromJust $ d_get du) :: Int - asFrac a b = (fromIntegral a) + ((fromIntegral b) * 0.000001) - - --- 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 - where scaledN = fromIntegral $ (f range (n)) -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, - nrpn 0x62 ch (c .&. 0x7F) t, - nrpn 0x06 ch (shift (n .&. 0x3F80) (-7)) t, - nrpn 0x26 ch (n .&. 0x7F) t - ] - mapM (sendEvent o) evts - return Nothing - -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 - 0x13, -- Equipment ID - 0x00, -- Device No. - 0x20, -- Message ID - 0x00, -- Location - shift (c .&. 0x3F80) (-7), -- Parameter Index high byte - (c .&. 0x7F), -- Parameter Index low byte - n, -- Parameter Value - 0xF7 -- End of SysEx - ] - - msg = B.pack $ bytes - - sendSysEx o t (BC.unpack msg) - --- PortMIDI Wrapper - -outputDevice :: PM.DeviceID -> Int -> IO (Either Output PM.PMError) -outputDevice deviceID latency = do - PM.initialize - now <- getCurrentTime - result <- PM.openOutput deviceID latency - case result of - Left dev -> - do - info <- PM.getDeviceInfo deviceID - putStrLn ("Opened: " ++ show (PM.interface info) ++ ": " ++ show (PM.name info)) - sem <- newEmptyMVar - putMVar sem () -- initially fill MVar to be taken by the first user of this output - buffer <- newMVar [] - - midiOffset <- PM.time - - let posixNow = realToFrac $ utcTimeToPOSIXSeconds now - syncedNow = posixNow - ((0.001*) $ fromIntegral midiOffset) - sec = floor syncedNow - usec = floor $ 1000000 * (syncedNow - (realToFrac sec)) - 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 - err <- PM.writeSysEx (conn o) t msg - putMVar sem () - 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 - cbuf <- takeMVar buf - putMVar buf (cbuf ++ [evt]) - return Nothing diff --git a/Sound/Tidal/MIDI/Stream.hs b/Sound/Tidal/MIDI/Stream.hs new file mode 100644 --- /dev/null +++ b/Sound/Tidal/MIDI/Stream.hs @@ -0,0 +1,368 @@ +module Sound.Tidal.MIDI.Stream (midiStream, midiBackend, midiState, midiSetters, midiDevices,send) where + +import Control.Monad.Trans.Maybe +-- generics +import qualified Data.Map as Map +import Data.List (sortBy) +import Data.Maybe +import Data.Ord (comparing) +import Data.Time (getCurrentTime, UTCTime, diffUTCTime) +import Data.Time.Clock.POSIX +import Control.Concurrent +import Control.Concurrent.MVar +import Data.Bits +import Foreign.C +import Control.Applicative + +import Numeric + +-- Tidal specific +import Sound.Tidal.Tempo (Tempo, cps, clockedTick) +import Sound.Tidal.Stream as S +import Sound.Tidal.Utils +import Sound.Tidal.Time +import Sound.Tidal.Transition (transition) + +-- MIDI specific +import Sound.Tidal.MIDI.Device +import Sound.Tidal.MIDI.Control +import qualified Sound.PortMidi as PM + + +type ConnectionCount = Int +type TickedConnectionCount = Int +type OutputOnline = Bool +type OutputState = (TickedConnectionCount, ConnectionCount, OutputOnline) +type MIDITime = (Tempo, Int, Double, Double) +type MIDIEncoder = CULong -> PM.PMEvent +type MIDIEvent = (MIDITime, MIDIEncoder) + +data Output = Output { + conn :: PM.PMStream, + buffer :: MVar [MIDIEvent], + bufferstate :: MVar OutputState + } + +type MidiMap = Map.Map S.Param (Maybe Int) +type MidiDeviceMap = Map.Map String Output + + +toMidiEvent :: ControllerShape -> S.Param -> Value -> Maybe Int +toMidiEvent s p (VF x) = ($) <$> mscale <*> mrange <*> pure x + where + mrange = fmap range mcc + mscale = fmap scalef mcc + mcc = paramN s p +toMidiEvent s p (VI x) = Just x +toMidiEvent s p (VS x) = Nothing -- ignore strings for now, we might 'read' them later + +toMidiMap :: ControllerShape -> S.ParamMap -> MidiMap +toMidiMap s m = Map.mapWithKey (toMidiEvent s) (Map.mapMaybe (id) m) + +send s ch cshape shape change tick o ctrls (tdur:tnote:trest) = midi + where + midi = sendmidi s cshape ch' (note, vel, dur) (change, tick, o, offset) ctrls + note = fromIntegral $ ivalue $ snd tnote + dur = realToFrac $ fvalue $ snd tdur + (vel, nudge) = case length trest of + 2 -> (mkMidi $ trest !! 1, fvalue $ snd $ trest !! 0) + 1 -> (mkMidi $ trest !! 0, 0) + ch' = fromIntegral ch + mkMidi = fromIntegral . floor . (*127) . fvalue . snd + offset = ((Sound.Tidal.MIDI.Control.latency cshape) + nudge) + +mkSend cshape channel s = return $ (\ shape change tick (o,m) -> do + let defaulted = (S.applyShape' shape m) + -- split ParamMap into Properties and Controls + mpartition = fmap (Map.partitionWithKey (\k _ -> (name k) `elem` ["dur", "n", "velocity", "nudge"])) defaulted + props = fmap fst mpartition + ctrls = fmap snd mpartition + props' = fmap (Map.toAscList) $ fmap (Map.mapMaybe (id)) props + -- only send explicitly set Control values + ctrls' = fmap (Map.filterWithKey (\k v -> v /= (defaultValue k))) ctrls + ctrls'' = fmap (toMidiMap cshape) ctrls' + send' = fmap (send s channel cshape shape change tick o) ctrls'' + ($) <$> send' <*> props' + ) + +connected cshape channel name s = do + putStrLn ("Successfully initialized Device '" ++ name ++ "'") + changeState goOnline s + mkSend cshape channel s + +failed di err = do + error (show err ++ ": " ++ show di) + +notfound name = do + putStrLn "List of Available Device Names" + putStrLn =<< displayOutputDevices + error ("Device '" ++ show name ++ "' not found") + +readState f o = do + s <- readMVar $ bufferstate o + let fs = f s + (ticked, conns, online) = s + return fs + +isCycling (0, conns, True) = True +isCycling _ = False + +displayState (ticked, conns, online) = show ticked ++ "/" ++ show conns ++ "[" ++ show online ++ "]" + +changeState f o = do + bs <- takeMVar stateM + let fs = f bs + (ticked, conns, online) = fs + putMVar stateM $ fs + where + stateM = bufferstate o + +goOnline (ticked, conns, online) = (ticked, conns, True) +addConnection (ticked, conns, online) = (ticked, conns + 1, online) +tickConnections (ticked, conns, online) = ((ticked + 1) `mod` conns, conns, online) + +useOutput outsM name lat = do + outs <- readMVar outsM -- blocks + let outM = Map.lookup name outs -- maybe + -- if we have a valid output by now, return + case outM of + Just o -> do + putStrLn "Cached Device Output" + changeState addConnection o -- blocks + return $ Just o + Nothing -> do + -- otherwise open a new output and store the result in the mvar + devidM <- (>>= maybe (failed name "Failed opening MIDI Output Device ID") return) (getIDForDeviceName name) + econn <- outputDevice devidM lat -- either + case econn of + Left o -> do + changeState addConnection o + swapMVar outsM $ Map.insert name o outs + return $ Just o + Right _ -> return Nothing + +makeConnection :: MVar (MidiDeviceMap) -> String -> Int -> ControllerShape -> IO ((S.ToMessageFunc), Output) +makeConnection devicesM deviceName channel cshape = do + moutput <- useOutput devicesM deviceName 1 + case moutput of + Just o -> do + s <- connected cshape channel deviceName o + return (s, o) + Nothing -> + --failed o + error "Failed" + +showLate :: (CULong, Double, PM.PMEvent, CULong, UTCTime) -> String +showLate (o, t, e, m, n) = + unwords ["late", + (show $ (\x -> [PM.status x, PM.data1 x, PM.data2 x]) $ PM.decodeMsg $ PM.message e), + "midi now ", show m, " midi onset: ", show o, + "onset (relative): ", show $ showFFloat (Just 3) (t - (realToFrac $ utcTimeToPOSIXSeconds n)) "", + ", sched: ", show $ PM.timestamp e] + + +-- should only send out events if all connections have ticked +flushBackend :: Output -> S.Shape -> Tempo -> Int -> IO () +flushBackend o shape change ticks = do + changeState tickConnections o + cycling <- readState isCycling o + + case cycling of + True -> do + late <- sendevents o shape change ticks + let len = length late + + case len of + 0 -> + return () + _ -> do + putStrLn $ showLate $ head late + putStrLn $ "and " ++ show (len - 1) ++ " more" + False -> do + s <- readState displayState o + + return () + + +midiDevices :: IO (MVar (MidiDeviceMap)) +midiDevices = do + newMVar $ Map.fromList [] + +midiBackend d n c cs = do + (s, o) <- makeConnection d n c cs + return $ Backend s (flushBackend o) + +midiStream d n c s = do + backend <- midiBackend d n c s + stream backend (toShape s) + +midiState d n c s = do + backend <- midiBackend d n c s + S.state backend (toShape s) + +midiSetters :: MVar (MidiDeviceMap) -> String -> Int -> ControllerShape -> IO Time -> IO (ParamPattern -> IO (), (Time -> [ParamPattern] -> ParamPattern) -> ParamPattern -> IO ()) +midiSetters d n c s getNow = do + ds <- midiState d n c s + return (setter ds, transition getNow ds) + + +toDescriptor midiTime now (o,m,t,e) = (o,t,e, midiTime, now) + +calcOnsets (a@(tempo, tick, onset, offset), e) = (a, logicalOnset' tempo tick onset offset, e) + +showEvent :: PM.PMEvent -> String +showEvent e = show t ++ " " ++ show msg + where msg = PM.decodeMsg $ PM.message e + t = PM.timestamp e + +showRawEvent :: (CULong, MIDITime, Double, PM.PMEvent) -> String +showRawEvent (midionset, (tempo,tick,onset,offset), logicalOnset, e) = show onset ++ " " ++ " / " ++ show logicalOnset ++ " " ++ showEvent e + +sendevents :: Output -> S.Shape -> Tempo -> Int -> IO ([(CULong, Double, PM.PMEvent, CULong, UTCTime)]) +sendevents stream shape change ticks = do + let buf = buffer stream + output = conn stream + buf' <- tryTakeMVar buf + case buf' of + Nothing -> do + return [] + Just [] -> do + -- make sure we put back an empty buffer + putMVar buf [] + return [] + (Just evts@(x:xs)) -> do + midiTime <- PM.time + now <- getCurrentTime + + let offset = S.latency shape + nextTick = logicalOnset' change (ticks+1) 0 offset + onsets = map calcOnsets evts + -- split into events sent now and later (e.g. a noteOff that would otherwise cut off noteOn's in the next tick) + (evts', later) = span ((< nextTick).(\(_,o,_) -> o)) $ sortBy (comparing (\(_,o,_) -> o)) onsets + -- calculate MIDI time to schedule events, putting time into fn to create PM.PMEvents + evts'' = map (\(t, o, e) -> let midionset = scheduleTime midiTime now o + in (midionset, t, o, e midionset)) evts' + later' = map (\(t,o,e) -> (t,e)) later + evts''' = map (\(_,_,_,e) -> e) evts'' + -- filter events that are too late + late = map (toDescriptor midiTime now) $ filter (\(_,_,t,_) -> t < (realToFrac $ utcTimeToPOSIXSeconds now)) $ evts'' + + -- write events for this tick to stream + err <- PM.writeEvents output evts''' + -- store later events for nextTick + putMVar buf later' + case err of + PM.NoError -> do + -- return events for logging in outer scope + return late + e -> do + putStrLn "sending failed" + return [] + + +sendctrls :: Output -> ControllerShape -> CLong -> MIDITime -> MidiMap -> IO () +sendctrls stream shape ch t ctrls = do + let ctrls' = filter ((>=0) . snd) $ Map.toList $ Map.mapMaybe (id) ctrls + sequence_ $ map (\(param, ctrl) -> makeCtrl stream ch (fromJust $ paramN shape param) (fromIntegral ctrl) t) ctrls' -- FIXME: we should be sure param has ControlChange + return () + +sendnote :: Output -> t -> CLong -> (CLong, CLong, Double) -> MIDITime -> IO () +sendnote stream shape ch (note,vel, dur) (tempo,tick,onset,offset) = + do + noteOn stream ch midinote vel (tempo,tick,onset,offset) + noteOff stream ch midinote (tempo, tick, onset, offset + dur) + return () + where midinote = note + 60 + +scheduleTime :: CULong -> UTCTime -> Double -> CULong +scheduleTime mnow' now' logicalOnset = t + where + now = realToFrac $ utcTimeToPOSIXSeconds $ now' + mnow = fromIntegral mnow' + t = floor $ mnow + (1000 * (logicalOnset - now)) -- 1 second are 1000 microseconds as is the unit of timestamps in PortMidi + + +sendmidi :: Output -> ControllerShape -> CLong -> (CLong, CLong, Double) -> MIDITime -> MidiMap -> IO () +sendmidi stream shape ch n t ctrls = do + sendmidi' stream shape ch n t ctrls + return () + + +sendmidi' stream shape ch (128,vel,dur) t ctrls = do + sendctrls stream shape ch t ctrls + return () +sendmidi' stream shape ch (note,vel,dur) t ctrls = do + sendnote stream shape ch (note,vel,dur) t + sendctrls stream shape ch t ctrls + return () + + +-- MIDI Utils +encodeChannel :: (Bits a, Num a) => a -> a -> a +encodeChannel ch cc = (((-) ch 1) .|. cc) + + +-- MIDI Messages +noteOn :: Output -> CLong -> CLong -> CLong -> MIDITime -> IO (Maybe a) +noteOn o ch val vel t = do + let evt = (t, \t' -> makeEvent 0x90 val ch vel t') + sendEvent o evt + +noteOff :: Output -> CLong -> CLong -> MIDITime -> IO (Maybe a) +noteOff o ch val t = do + let evt = (t, \t' -> makeEvent 0x80 val ch 60 t') + sendEvent o evt + +makeCtrl :: Output -> CLong -> ControlChange -> CLong -> MIDITime -> IO (Maybe a) +makeCtrl o ch (CC {midi=midi, range=range}) n t = makeCC o ch (fromIntegral midi) n t +makeCtrl o ch (NRPN {midi=midi, range=range}) n t = makeNRPN o ch (fromIntegral midi) n t + +-- This is sending CC +makeCC :: Output -> CLong -> CLong -> CLong -> MIDITime -> IO (Maybe a) +makeCC o ch c n t = do + let evt = (t, \t' -> makeEvent 0xB0 c ch n t') + sendEvent o evt + +-- This is sending NRPN +makeNRPN :: Output -> CLong -> CLong -> CLong -> MIDITime -> IO (Maybe a) +makeNRPN o ch c n t = do + let nrpn = makeEvent 0xB0 + evts = [(t, (\t' -> nrpn 0x63 ch (shift (c .&. 0x3F80) (-7)) t')), + (t, (\t' -> nrpn 0x62 ch (c .&. 0x7F) t')), + (t, (\t' -> nrpn 0x06 ch (shift (n .&. 0x3F80) (-7)) t')), + (t, (\t' -> nrpn 0x26 ch (n .&. 0x7F) t')) + ] + mapM (sendEvent o) evts + return Nothing + + +-- Port Midi Wrapper + +outputDevice :: PM.DeviceID -> Int -> IO (Either Output PM.PMError) +outputDevice deviceID latency = do + PM.initialize + now <- getCurrentTime + result <- PM.openOutput deviceID latency + bs <- newMVar (0, 0, False) + case result of + Left dev -> + do + info <- PM.getDeviceInfo deviceID + putStrLn ("Opened: " ++ show (PM.interface info) ++ ": " ++ show (PM.name info)) + buffer <- newMVar [] + + return (Left Output { conn=dev, buffer=buffer, bufferstate=bs }) + 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.encodeMsg $ PM.PMMsg (encodeChannel ch st) (n) (v) + +sendEvent :: Output -> (MIDITime, (CULong -> PM.PMEvent)) -> IO (Maybe a) +sendEvent o evt = do + let buf = buffer o + + cbuf <- takeMVar buf + putMVar buf (cbuf ++ [evt]) + return Nothing diff --git a/Sound/Tidal/MIDI/Synth.hs b/Sound/Tidal/MIDI/Synth.hs new file mode 100644 --- /dev/null +++ b/Sound/Tidal/MIDI/Synth.hs @@ -0,0 +1,17 @@ +module Sound.Tidal.MIDI.Synth where + +import Sound.Tidal.Params +import Sound.Tidal.MIDI.Control + +synthController :: ControllerShape +synthController = ControllerShape { + controls = [ + mCC modwheel_p 1, + mCC pan_p 10, + mCC expression_p 11, + mCC sustainpedal_p 64 + ], + latency = 0.04 + } + +synth = toShape synthController diff --git a/Sound/Tidal/MIDI/SynthParams.hs b/Sound/Tidal/MIDI/SynthParams.hs new file mode 100644 --- /dev/null +++ b/Sound/Tidal/MIDI/SynthParams.hs @@ -0,0 +1,46 @@ +{- | +Module: SynthParams +Description: Parameters to control synth + +In general, synth parameters specify patterns of sounds, and patterns of effects on those sounds. These are the synthesis parameters you can use with the default Dirt synth: +-} +module Sound.Tidal.MIDI.SynthParams ( + sound, + grp, + accelerate, + bandf, + bandq, + begin, + channel, + coarse, + crush, + cut, + cutoff, + cutoffegint, + delay, + delayfeedback, + delaytime, + detune, + dry, + end, + gain, + hcutoff, + hresonance, + loop, + n, + nudge, + offset, + orbit, + pan, + resonance, + room, + shape, + size, + speed, + s, + unit, + velocity, + vowel + ) where + +import Sound.Tidal.Params diff --git a/Sound/Tidal/MIDI/VolcaBass.hs b/Sound/Tidal/MIDI/VolcaBass.hs new file mode 100644 --- /dev/null +++ b/Sound/Tidal/MIDI/VolcaBass.hs @@ -0,0 +1,27 @@ +module Sound.Tidal.MIDI.VolcaBass where + +import Sound.Tidal.Params +import Sound.Tidal.MIDI.Control + +bassController :: ControllerShape +bassController = ControllerShape { controls = [ + mCC slide_p 5, + mCC expression_p 11, + mCC octave_p 40, + mCC lfo_p 41, + mCC lfoint_p 42, + mCC pitch1_p 43, + mCC pitch2_p 44, + mCC pitch3_p 45, + mCC attack_p 46, + mCC decay_p 47, + mCC cutoff_p 48, + mCC gate_p 49 + ], + --duration = ("dur", 0.05), + --velocity = ("vel", 0.5), + latency = 0.01 + } + +bass = toShape bassController + diff --git a/Sound/Tidal/MIDI/VolcaBeats.hs b/Sound/Tidal/MIDI/VolcaBeats.hs new file mode 100644 --- /dev/null +++ b/Sound/Tidal/MIDI/VolcaBeats.hs @@ -0,0 +1,35 @@ +module Sound.Tidal.MIDI.VolcaBeats where + +import Sound.Tidal.Params +import Sound.Tidal.MIDI.Control + +beatsController :: ControllerShape +beatsController = ControllerShape { controls = [ + mCC lkick_p 40, + mCC lsnare_p 41, + mCC llotom_p 42, + mCC lhitom_p 43, + mCC lclhat_p 44, + mCC lophat_p 45, + mCC lclap_p 46, + mCC lclaves_p 47, + mCC lagogo_p 48, + mCC lcrash_p 49, + mCC sclap_p 50, + mCC sclaves_p 51, + mCC sagogo_p 52, + mCC scrash_p 53, + mCC stuttertime_p 54, + mCC stutterdepth_p 55, + mCC tomdecay_p 56, + mCC clhatdecay_p 57, + mCC ophatdecay_p 58, + mCC hatgrain_p 59 + ], + -- duration = ("dur", 0.05), + -- velocity = ("vel", 0.5), + latency = 0.01 + } + +-- What is this used for? +beats = toShape beatsController diff --git a/Sound/Tidal/MIDI/VolcaKeys.hs b/Sound/Tidal/MIDI/VolcaKeys.hs new file mode 100644 --- /dev/null +++ b/Sound/Tidal/MIDI/VolcaKeys.hs @@ -0,0 +1,30 @@ +module Sound.Tidal.MIDI.VolcaKeys where + +import Sound.Tidal.Params +import Sound.Tidal.MIDI.Control + +keysController :: ControllerShape +keysController = ControllerShape { controls = [ + mCC portamento_p 5, + mCC expression_p 11, + mCC voice_p 40, -- voi + mCC octave_p 41, -- oct + mCC detune_p 42, -- det + mCC vcoegint_p 43, -- vco + mCC cutoff_p 44, -- ctf + mCC vcfegint_p 45, -- vcf + mCC lfo_p 46, + mCC lfopitchint_p 47, -- lfop + mCC lfocutoffint_p 48, -- lfoc + mCC attack_p 49, -- att + mCC decay_p 50, -- dec + mCC sustain_p 51, -- sus + mCC delaytime_p 52, -- delayt + mCC delayfeedback_p 53 -- delayfb + ], + -- duration = ("dur", 0.05), + -- velocity = ("vel", 0.5), + latency = 0.01 + } + +keys = toShape keysController diff --git a/Sound/Tidal/Rytm.hs b/Sound/Tidal/Rytm.hs deleted file mode 100644 --- a/Sound/Tidal/Rytm.hs +++ /dev/null @@ -1,203 +0,0 @@ -module Sound.Tidal.Rytm where - -import Sound.Tidal.Stream (makeI, makeF) - -import Sound.Tidal.MIDI.Control - -keys :: ControllerShape -keys = ControllerShape { params = [ - - mCC "synth1" 16, - mCC "synth2" 17, - mCC "synth3" 18, - mCC "synth4" 19, - mCC "synth5" 20, - mCC "synth6" 21, - mCC "synth7" 22, - mCC "synth8" 23, - - mCC "revpre" 24, - mCC "revtime" 25, - mCC "revfrq" 26, - mCC "revgain" 27, - mCC "revhpf" 28, - mCC "revlpf" 29, - mCC "revvol" 31, - - mCC "samptune" 24, - mCC "sampfinetune" 25, - mCC "sampbitreduction" 26, - mCC "sampslot" 27, - mCC "sampstart" 28, - mCC "sampend" 29, - mCC "samploop" 30, - mCC "samplevel" 31, - - mCC "machtype" 15, - - mCC "filtatk" 70, - mCC "filtdec" 71, - mCC "filtsus" 72, - mCC "filtrel" 73, - mCC "filtfrq" 74, - mCC "filtres" 75, - mCC "filttyp" 76, - mCC "filtenv" 77, - - mCC "perf1" 35, - mCC "perf2" 36, - mCC "perf3" 37, - mCC "perf4" 39, - mCC "perf5" 40, - mCC "perf6" 41, - mCC "perf7" 42, - mCC "perf8" 43, - - mCC "atk" 78, - mCC "hld" 79, - mCC "dec" 80, - mCC "ovr" 81, - mCC "del" 82, - mCC "amprev" 83, - mCC "amppan" 10, - mCC "vol" 7 - ], - duration = ("dur", 0.05), - velocity = ("vel", 0.5), - latency = 0.1 - } - -oscKeys = toOscShape keys - --- note on/off -note = makeI oscKeys "note" -dur = makeF oscKeys "dur" - --- standard synth params -synth1 = makeF oscKeys "synth1" -synth2 = makeF oscKeys "synth2" -synth3 = makeF oscKeys "synth3" -synth4 = makeF oscKeys "synth4" -synth5 = makeF oscKeys "synth5" -synth6 = makeF oscKeys "synth6" -synth7 = makeF oscKeys "synth7" -synth8 = makeF oscKeys "synth8" - --- machine type (e.g. hard snare, classic snare, hard bd, classic bd, etc) -machtype = makeF oscKeys "machtype" - --- generic synth level and tuning -lev = makeF oscKeys "synth1" -tun = makeF oscKeys "synth2" - --- generic bd decay and sweep type -bddec = makeF oscKeys "synth3" -bdswt = makeF oscKeys "synth5" - --- FM bd params -fmbdfmamt = makeF oscKeys "synth4" -fmbdfmswt = makeF oscKeys "synth6" -fmbdfmdec = makeF oscKeys "synth7" -fmbdfmtun = makeF oscKeys "synth8" - --- hard bd params -hardbdhold = makeF oscKeys "synth4" -hardbdsnap = makeF oscKeys "synth6" -hardbdwav = makeF oscKeys "synth7" -hardbdtic = makeF oscKeys "synth8" - --- classic bd params -clasbdswd = makeF oscKeys "synth6" -clasbdtra = makeF oscKeys "synth7" -clasbdwav = makeF oscKeys "synth8" - --- generic sd params (decay, noise decay, noise level) -sddec = makeF oscKeys "synth3" -sdnod = makeF oscKeys "synth6" -sdnol = makeF oscKeys "synth7" - --- hard sd params -hardsdswd = makeF oscKeys "synth4" -hardsdtic = makeF oscKeys "synth5" -hardsdswt = makeF oscKeys "synth8" - --- classic sd params -classddet = makeF oscKeys "synth4" -classdsnp = makeF oscKeys "synth5" -classdbal = makeF oscKeys "synth8" - --- FM sd params -fmsdfmt = makeF oscKeys "synth4" -fmsdfmd = makeF oscKeys "synth5" -fmsdfma = makeF oscKeys "synth8" - --- BT -btdec = makeF oscKeys "synth3" - --- CP -cpton = makeF oscKeys "synth2" -cpnod = makeF oscKeys "synth3" -cpnum = makeF oscKeys "synth4" -cprat = makeF oscKeys "synth5" -cpnol = makeF oscKeys "synth6" -cprnd = makeF oscKeys "synth7" -cpcpd = makeF oscKeys "synth8" - --- filter params -filtatk = makeF oscKeys "filtatk" -filtdec = makeF oscKeys "filtdec" -filtsus = makeF oscKeys "filtsus" -filtrel = makeF oscKeys "filtrel" -filtfrq = makeF oscKeys "filtfrq" -filtres = makeF oscKeys "filtres" -filttyp = makeF oscKeys "filttyp" -filtenv = makeF oscKeys "filtenv" - --- amplitude params -atk = makeF oscKeys "atk" -hld = makeF oscKeys "hld" -dec = makeF oscKeys "dec" -ovr = makeF oscKeys "ovr" -del = makeF oscKeys "del" -amprev = makeF oscKeys "amprev" -amppan = makeF oscKeys "amppan" -vol = makeF oscKeys "vol" - --- delay params (only used on FX MIDI channel) -deltime = makeF oscKeys "synth1" -delpingpong = makeF oscKeys "synth2" -delwidth = makeF oscKeys "synth3" -delfeedback = makeF oscKeys "synth4" -delhpf = makeF oscKeys "synth5" -dellpf = makeF oscKeys "synth6" -delrev = makeF oscKeys "synth7" -delvol = makeF oscKeys "synth8" - --- reverb params (only used on FX MIDI channel) -revpre = makeF oscKeys "revpre" -revtime = makeF oscKeys "revtime" -revfrq = makeF oscKeys "revfrq" -revgain = makeF oscKeys "revgain" -revhpf = makeF oscKeys "revhpf" -revlpf = makeF oscKeys "revlpf" -revvol = makeF oscKeys "revvol" - --- performance -perf1 = makeF oscKeys "perf1" -perf2 = makeF oscKeys "perf2" -perf3 = makeF oscKeys "perf3" -perf4 = makeF oscKeys "perf4" -perf5 = makeF oscKeys "perf5" -perf6 = makeF oscKeys "perf6" -perf7 = makeF oscKeys "perf7" -perf8 = makeF oscKeys "perf8" - --- sample -samptune = makeF oscKeys "samptune" -sampfinetune = makeF oscKeys "sampfinetune" -sampbitreduction = makeF oscKeys "sampbitreduction" -sampslot = makeF oscKeys "sampslot" -sampstart = makeF oscKeys "sampstart" -sampend = makeF oscKeys "sampend" -samploop = makeF oscKeys "samploop" -samplevel = makeF oscKeys "samplevel" diff --git a/Sound/Tidal/SimpleSynth.hs b/Sound/Tidal/SimpleSynth.hs deleted file mode 100644 --- a/Sound/Tidal/SimpleSynth.hs +++ /dev/null @@ -1,26 +0,0 @@ -module Sound.Tidal.SimpleSynth where - -import Sound.Tidal.Stream (makeI, makeF) - -import Sound.Tidal.MIDI.Control - -keys :: ControllerShape -keys = ControllerShape {params = [ - mCC "modwheel" 1, - mCC "balance" 10, - mCC "expression" 11, - mCC "sustainpedal" 64 - ], - duration = ("dur", 0.05), - velocity = ("vel", 0.5), - latency = 0.1} - -oscKeys = toOscShape keys - -note = makeI oscKeys "note" -dur = makeF oscKeys "dur" -vel = makeF oscKeys "vel" -modwheel = makeF oscKeys "modwheel" -balance = makeF oscKeys "balance" -expression = makeF oscKeys "expression" -sustainpedal = makeF oscKeys "sustainpedal" diff --git a/Sound/Tidal/Synthino.hs b/Sound/Tidal/Synthino.hs deleted file mode 100644 --- a/Sound/Tidal/Synthino.hs +++ /dev/null @@ -1,52 +0,0 @@ -module Sound.Tidal.Synthino where - -import Sound.Tidal.Stream (makeI, makeF) - -import Sound.Tidal.MIDI.Control - -keys :: ControllerShape -keys = ControllerShape { params = [ - mCC "attack" 73, - mCC "decay" 75, - mCC "sustain" 79, - mCC "release" 72, - mCC "waveform" 70, - mCC "pitchlforate" 76, - mCC "pitchlfodepth" 1, - mCC "lfowaveform" 12, - mCC "filterlforate" 13, - mCC "filterlfodepth" 91, - mCC "peak" 71, - mCC "kcutoff" 74, - mCC "bpm" 16, - mCC "arplength" 17, - mCC "arptranspose" 18, - mCC "vol" 7, - mCC "off" 123 - ], - duration = ("dur", 0.05), - velocity = ("vel", 0.5), - latency = 0.1 - } - -oscKeys = toOscShape keys - -note = makeI oscKeys "note" -dur = makeF oscKeys "dur" -attack = makeF oscKeys "attack" -decay = makeF oscKeys "decay" -sustain = makeF oscKeys "sustain" -release = makeF oscKeys "release" -waveform = makeF oscKeys "waveform" -pitchlforate = makeF oscKeys "pitchlforate" -pitchlfodepth = makeF oscKeys "pitchlfodepth" -lfowaveform = makeF oscKeys "lfowaveform" -filterlforate = makeF oscKeys "filterlforate" -filterlfodepth = makeF oscKeys "filterlfodepth" -peak = makeF oscKeys "peak" -kcutoff = makeF oscKeys "kcutoff" -bpm = makeF oscKeys "bpm" -arplength = makeF oscKeys "arplength" -arptranspose = makeF oscKeys "arptranspose" -vol = makeF oscKeys "vol" -off = makeF oscKeys "off" diff --git a/Sound/Tidal/Tetra.hs b/Sound/Tidal/Tetra.hs deleted file mode 100644 --- a/Sound/Tidal/Tetra.hs +++ /dev/null @@ -1,530 +0,0 @@ -module Sound.Tidal.Tetra where - -import Sound.Tidal.Stream (makeI, makeF, (|+|), merge, OscPattern) - -import Sound.Tidal.MIDI.Control - -import Sound.Tidal.Parse -import Sound.Tidal.Pattern - -import Control.Applicative - -makeSeqTracks = concat $ map makeSeqTrack [0..3] - where makeSeqTrack t = map (makeSeqStep t) [0..15] - makeSeqStep t s = NRPN (makeName t s) (makeCC t s) (0, 127) 0 passThru - makeName t s = "seq" ++ (show $ t + 1) ++ "step" ++ (show $ s + 1) - makeCC t s = (t * 16) + (s + 120) - -polysynth :: ControllerShape -polysynth = ControllerShape { params = ([ - mrNRPN "osc1freq" 0 (0, 120) 0.2, - mrNRPN "osc1detune" 1 (0, 100) 0.5, - NRPN "osc1shape" 2 (0, 103) 1 passThru, - mNRPN "osc1glide" 3, - NRPN "osc1kbd" 4 (0, 1) 1 passThru, - - mrNRPN "osc2freq" 5 (0, 120) 0.2, - mrNRPN "osc2detune" 6 (0, 100) 0.5, - NRPN "osc2shape" 7 (0, 103) 1 passThru, - mNRPN "osc2glide" 8, - NRPN "osc2kbd" 9 (0, 1) 1 passThru, - - NRPN "oscsync" 10 (0, 1) 0 passThru, - NRPN "glidemode" 11 (0, 3) 0 passThru, - NRPN "oscslop" 12 (0, 5) 0 passThru, - mrNRPN "oscmix" 13 (0, 127) 0.5, - - mNRPN "noise" 14, - mrNRPN "kcutoff" 15 (0, 164) 1, - mNRPN "kresonance" 16, - mNRPN "kamt" 17, - mNRPN "audiomod" 18, - NRPN "fpoles" 19 (0, 1) 1 passThru, - - -- filter envelope - mrNRPN "famt" 20 (0, 254) 0.5, - mNRPN "fvel" 21, - mNRPN "fdel" 22, - mNRPN "fatk" 23, - mNRPN "fdcy" 24, - mNRPN "fsus" 25, - mNRPN "frel" 26, - - - mNRPN "vcavol" 27, - mNRPN "outspread" 28, - mrNRPN "vol" 29 (0, 127) 1, -- max volume by default - - mrNRPN "vamt" 30 (0, 127) 1, -- max vca envelope amount - mNRPN "vvel" 31, - mNRPN "vdel" 32, - mNRPN "vatk" 33, - mrNRPN "vdcy" 34 (0, 127) 0.5, - mrNRPN "vsus" 35 (0, 127) 0.5, - mNRPN "vrel" 36, - - NRPN "lfo1rate" 37 (0, 166) 0 passThru, -- unsynced - -- mrNRPN "lfo1step" 37 (151, 166) 0, -- (bpm / 32) - 16 bpm-cycles - NRPN "lfo1shape" 38 (0, 4) 0 passThru, - mNRPN "lfo1amt" 39, - NRPN "lfo1dest" 40 (0, 43) 0 passThru, - NRPN "lfo1sync" 41 (0, 1) 0 passThru, - - NRPN "lfo2rate" 42 (0, 166) 0 passThru, -- unsynced - -- mrNRPN "lfo2step" 42 (151, 166) 0, -- (bpm / 32) - 16 bpm-cycles - NRPN "lfo2shape" 43 (0, 4) 0 passThru, - mNRPN "lfo2amt" 44, - NRPN "lfo2dest" 45 (0, 43) 0 passThru, - NRPN "lfo2sync" 46 (0, 1) 0 passThru, - - NRPN "lfo3rate" 47 (0, 166) 0 passThru, -- unsynced - -- mrNRPN "lfo3step" 47 (151, 166) 0, -- (bpm / 32) - 16 bpm-cycles - NRPN "lfo3shape" 48 (0, 4) 0 passThru, - mNRPN "lfo3amt" 49, - NRPN "lfo3dest" 50 (0, 43) 0 passThru, - NRPN "lfo3sync" 51 (0, 1) 0 passThru, - - NRPN "lfo4rate" 52 (0, 166) 0 passThru, -- unsynced - -- mrNRPN "lfo4step" 52 (151, 166) 0, -- (bpm / 32) - 16 bpm-cycles - NRPN "lfo4shape" 53 (0, 4) 0 passThru, - mNRPN "lfo4amt" 54, - NRPN "lfo4dest" 55 (0, 43) 0 passThru, - NRPN "lfo4sync" 56 (0, 1) 0 passThru, - - NRPN "emod" 57 (0, 43) 0 passThru, - mrNRPN "eamt" 58 (0, 254) 0.5, - mNRPN "evel" 59, - mNRPN "edel" 60, - mNRPN "eatk" 61, - mNRPN "edcy" 62, - mNRPN "esus" 63, - mNRPN "erel" 64, - - NRPN "mod1src" 65 (0, 20) 0 passThru, - mrNRPN "mod1amt" 66 (0, 254) 0.5, - NRPN "mod1dst" 67 (0, 47) 0 passThru, - - NRPN "mod2src" 68 (0, 20) 0 passThru, - mrNRPN "mod2amt" 69 (0, 254) 0.5, - NRPN "mod2dst" 70 (0, 47) 0 passThru, - - NRPN "mod3src" 71 (0, 20) 0 passThru, - mrNRPN "mod3amt" 72 (0, 254) 0.5, - NRPN "mod3dst" 73 (0, 47) 0 passThru, - - NRPN "mod4src" 74 (0, 20) 0 passThru, - mrNRPN "mod4amt" 75 (0, 254) 0.5, - NRPN "mod4dst" 76 (0, 47) 0 passThru, - - NRPN "seq1dst" 77 (0, 47) 0 passThru, - NRPN "seq2dst" 78 (0, 47) 0 passThru, - NRPN "seq3dst" 79 (0, 47) 0 passThru, - NRPN "seq4dst" 80 (0, 47) 0 passThru, - - mrNRPN "mwhl" 81 (0, 254) 0.5, - NRPN "mwhldst" 82 (0, 47) 0 passThru, - - mrNRPN "aftt" 83 (0, 254) 0.5, - NRPN "afttdst" 84 (0, 47) 0 passThru, - - mrNRPN "breath" 85 (0, 254) 0.5, - NRPN "breathdst" 86 (0, 47) 0 passThru, - - mrNRPN "mvel" 87 (0, 254) 0.5, - NRPN "mveldst" 88 (0, 47) 0 passThru, - - mrNRPN "foot" 89 (0, 254) 0.5, - NRPN "footdst" 90 (0, 47) 0 passThru, - - NRPN "kbpm" 91 (30, 250) 0 passThru, - NRPN "clockdiv" 92 (0, 12) 0 passThru, -- TODO: document values - - NRPN "bendrng" 93 (0, 12) 0 passThru, - - NRPN "sqntrig" 94 (0, 4) 0 passThru, -- TODO: document values - NRPN "unisonkey" 95 (0, 5) 0 passThru, -- TODO: document values - NRPN "unisonmode" 96 (0, 4) 0 passThru, -- TODO: document values - NRPN "arpmode" 97 (0, 14) 0 passThru, - - NRPN "erepeat" 98 (0, 1) 0 passThru, - NRPN "unison" 99 (0, 1) 0 passThru, - - - NRPN "arp" 100 (0, 1) 0 passThru, - NRPN "sqn" 101 (0, 1) 0 passThru, - - NRPN "mcr1" 105 (0, 183) 0 passThru, - NRPN "mcr2" 106 (0, 183) 0 passThru, - NRPN "mcr3" 107 (0, 183) 0 passThru, - NRPN "mcr4" 108 (0, 183) 0 passThru, - - mNRPN "fbgain" 110, - - mrNRPN "btnfreq" 111 (0, 127) 0.25, - mrNRPN "btnvel" 112 (0, 127) 1, - NRPN "btnmode" 113 (0, 1) 0 passThru, - - mNRPN "sub1vol" 114, - mNRPN "sub2vol" 115, - - mNRPN "fbvol" 116, - - -- left out: editor byte, - - mrNRPN "ksplitpoint" 118 (0, 127) 0.5, - NRPN "kmode" 119 (0, 2) 0 passThru, -- TODO: document values - mCC "notesoff" 123, - mCC "ccreset" 121, - mCC "damp" 64 - - ] ++ makeSeqTracks), - duration = ("dur", 0.2), - velocity = ("vel", 0.5), - latency = 0.04 - } - -oscPolysynth = toOscShape polysynth - -note = makeI oscPolysynth "note" - -dur = makeF oscPolysynth "dur" -vel = makeF oscPolysynth "vel" -notesoff = makeF oscPolysynth "notesoff" -ccreset = makeF oscPolysynth "ccreset" -damp = makeF oscPolysynth "damp" - - -osc1freq = makeF oscPolysynth "osc1freq" -osc1detune = makeF oscPolysynth "osc1detune" -osc1shape = makeF oscPolysynth "osc1shape" -osc1glide = makeF oscPolysynth "osc1glide" -osc1kbd = makeF oscPolysynth "osc1kbd" - -osc2freq = makeF oscPolysynth "osc2freq" -osc2detune = makeF oscPolysynth "osc2detune" -osc2shape = makeF oscPolysynth "osc2shape" -osc2glide = makeF oscPolysynth "osc2glide" -osc2kbd = makeF oscPolysynth "osc2kbd" - -oscsync = makeF oscPolysynth "oscsync" -glidemode = makeF oscPolysynth "glidemode" -oscslop = makeF oscPolysynth "oscslop" -oscmix = makeF oscPolysynth "oscmix" - -noise = makeF oscPolysynth "noise" -kcutoff = makeF oscPolysynth "kcutoff" -kresonance = makeF oscPolysynth "kresonance" -kamt = makeF oscPolysynth "kamt" -audiomod = makeF oscPolysynth "audiomod" -fpoles = makeF oscPolysynth "fpoles" -twopole = fpoles (p "0") -fourpole = fpoles (p "1") - --- filter envelope -famt = makeF oscPolysynth "famt" -fvel = makeF oscPolysynth "fvel" -fdel = makeF oscPolysynth "fdel" -fatk = makeF oscPolysynth "fatk" -fdcy = makeF oscPolysynth "fdcy" -fsus = makeF oscPolysynth "fsus" -frel = makeF oscPolysynth "frel" - - -vcavol = makeF oscPolysynth "vcavol" -outspread = makeF oscPolysynth "outspread" -vol = makeF oscPolysynth "vol" - -vamt = makeF oscPolysynth "vamt" -vvel = makeF oscPolysynth "vvel" -vdel = makeF oscPolysynth "vdel" -vatk = makeF oscPolysynth "vatk" -vdcy = makeF oscPolysynth "vdcy" -vsus = makeF oscPolysynth "vsus" -vrel = makeF oscPolysynth "vrel" - -lfo1rate = makeF oscPolysynth "lfo1rate" --- lfo1step = makeF oscPolysynth "lfo1step" -lfo1shape = makeF oscPolysynth "lfo1shape" -lfo1amt = makeF oscPolysynth "lfo1amt" -lfo1dest = makeF oscPolysynth "lfo1dest" -lfo1sync = makeF oscPolysynth "lfo1sync" - -lfo2rate = makeF oscPolysynth "lfo2rate" --- lfo2step = makeF oscPolysynth "lfo2step" -lfo2shape = makeF oscPolysynth "lfo2shape" -lfo2amt = makeF oscPolysynth "lfo2amt" -lfo2dest = makeF oscPolysynth "lfo2dest" -lfo2sync = makeF oscPolysynth "lfo2sync" - -lfo3rate = makeF oscPolysynth "lfo3rate" --- lfo3step = makeF oscPolysynth "lfo3step" -lfo3shape = makeF oscPolysynth "lfo3shape" -lfo3amt = makeF oscPolysynth "lfo3amt" -lfo3dest = makeF oscPolysynth "lfo3dest" -lfo3sync = makeF oscPolysynth "lfo3sync" - -lfo4rate = makeF oscPolysynth "lfo4rate" --- lfo4step = makeF oscPolysynth "lfo4step" -lfo4shape = makeF oscPolysynth "lfo4shape" -lfo4amt = makeF oscPolysynth "lfo4amt" -lfo4dest = makeF oscPolysynth "lfo4dest" -lfo4sync = makeF oscPolysynth "lfo4sync" - -emod = makeF oscPolysynth "emod" -eamt = makeF oscPolysynth "eamt" -evel = makeF oscPolysynth "evel" -edel = makeF oscPolysynth "edel" -eatk = makeF oscPolysynth "eatk" -edcy = makeF oscPolysynth "edcy" -esus = makeF oscPolysynth "esus" -erel = makeF oscPolysynth "erel" - -mod1src = makeF oscPolysynth "mod1src" -mod1amt = makeF oscPolysynth "mod1amt" -mod1dst = makeF oscPolysynth "mod1dst" - -mod2src = makeF oscPolysynth "mod2src" -mod2amt = makeF oscPolysynth "mod2amt" -mod2dst = makeF oscPolysynth "mod2dst" - -mod3src = makeF oscPolysynth "mod3src" -mod3amt = makeF oscPolysynth "mod3amt" -mod3dst = makeF oscPolysynth "mod3dst" - -mod4src = makeF oscPolysynth "mod4src" -mod4amt = makeF oscPolysynth "mod4amt" -mod4dst = makeF oscPolysynth "mod4dst" - -seq1dst = makeF oscPolysynth "seq1dst" -seq2dst = makeF oscPolysynth "seq2dst" -seq3dst = makeF oscPolysynth "seq3dst" -seq4dst = makeF oscPolysynth "seq4dst" - - -mwhl = makeF oscPolysynth "mwhl" -mwhldst = makeF oscPolysynth "mwhldst" - -aftt = makeF oscPolysynth "aftt" -afttdst = makeF oscPolysynth "afttdst" - -breath = makeF oscPolysynth "breath" -breathdst = makeF oscPolysynth "breathdst" - -mvel = makeF oscPolysynth "mvel" -mveldst = makeF oscPolysynth "mveldst" - -foot = makeF oscPolysynth "foot" -footdst = makeF oscPolysynth "footdst" - -bendrng = makeF oscPolysynth "bendrng" - --- left out: modwheel, breath, footctrl, pressure, velocity - -kbpm = makeF oscPolysynth "kbpm" -clockdiv = makeF oscPolysynth "clockdiv" - --- left out: pitchbend range - -sqntrig = makeF oscPolysynth "sqntrig" -unisonkey = makeF oscPolysynth "unisonkey" -unisonmode = makeF oscPolysynth "unisonmode" -arpmode = makeF oscPolysynth "arpmode" - -erepeat = makeF oscPolysynth "erepeat" -unison = makeF oscPolysynth "unison" - - -arp = makeF oscPolysynth "arp" -sqn = makeF oscPolysynth "sqn" - -mcr1 = makeF oscPolysynth "mcr1" -mcr2 = makeF oscPolysynth "mcr2" -mcr3 = makeF oscPolysynth "mcr3" -mcr4 = makeF oscPolysynth "mcr4" - -fbgain = makeF oscPolysynth "fbgain" - -btnfreq = makeF oscPolysynth "btnfreq" -btnvel = makeF oscPolysynth "btnvel" -btnmode = makeF oscPolysynth "btnmode" - -sub1vol = makeF oscPolysynth "sub1vol" -sub2vol = makeF oscPolysynth "sub2vol" - -fbvol = makeF oscPolysynth "fbvol" - -ksplitpoint = makeF oscPolysynth "ksplitpoint" -kmode = makeF oscPolysynth "kmode" -knormal = kmode (p "0") -kstack = kmode (p "0.5") -ksplit = kmode (p "1") - --- sequences - -seqtrack1 = map (makeF oscPolysynth . (\x -> "seq1step" ++ show x)) [1..16] -seqtrack2 = map (makeF oscPolysynth . (\x -> "seq2step" ++ show x)) [1..16] -seqtrack3 = map (makeF oscPolysynth . (\x -> "seq3step" ++ show x)) [1..16] -seqtrack4 = map (makeF oscPolysynth . (\x -> "seq4step" ++ show x)) [1..16] - - -seqpatterns p' = map onlyValues events - where arc' = arc p' - events = arc' (0,1) - onlyValues = \(_, _, a) -> p a - -sqnp i t p' = foldr (|+|) i (zipWith ($) t patterns) - where patterns = seqpatterns p' - -sqnp1 d p' = sqnp (seq1dst $ p $ show d) seqtrack1 p' -sqnp2 d p' = sqnp (seq2dst $ p $ show d) seqtrack2 p' -sqnp3 d p' = sqnp (seq3dst $ p $ show d) seqtrack3 p' -sqnp4 d p' = sqnp (seq4dst $ p $ show d) seqtrack4 p' - - --- abstractions - --- adsr - -atk p' = vatk p' |+| fatk p' |+| eatk p' -dcy p' = vdcy p' |+| fdcy p' |+| edcy p' -sus p' = vsus p' |+| fsus p' |+| esus p' -rel p' = vrel p' |+| frel p' |+| erel p' - -adsr a d s r = atk a |+| dcy d |+| sus s |+| rel r -asr a d r = atk a |+| dcy d |+| rel r - --- lfo - -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 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 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 - -doublePattern d = (p $ show d) :: Pattern Double - -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 - -dlfo1f = doublePattern 14 -dlfo2f = doublePattern 15 -dlfo3f = doublePattern 16 -dlfo4f = doublePattern 17 -dlfof = doublePattern 18 - -dlfo1a = doublePattern 19 -dlfo2a = doublePattern 20 -dlfo3a = doublePattern 21 -dlfo4a = doublePattern 22 -dlfoa = doublePattern 23 - -dfamt = doublePattern 24 -dvamt = doublePattern 25 -deamt = doublePattern 26 -damt = doublePattern 27 - -dfatk = doublePattern 28 -dvatk = doublePattern 29 -deatk = doublePattern 30 -datk = doublePattern 31 - -dfdcy = doublePattern 32 -dvdcy = doublePattern 33 -dedcy = doublePattern 34 -ddcy = doublePattern 35 - -dfrel = doublePattern 36 -dvrel = doublePattern 37 -derel = doublePattern 38 -drel = doublePattern 39 - -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 = doublePattern 1 -sseq2 = doublePattern 2 -sseq3 = doublePattern 3 -sseq4 = doublePattern 4 - -slfo1 = doublePattern 5 -slfo2 = doublePattern 6 -slfo3 = doublePattern 7 -slfo4 = doublePattern 8 - -sfenv = doublePattern 9 -svenv = doublePattern 10 -seenv = doublePattern 11 - -spitchb = doublePattern 12 -smodwh = doublePattern 13 -saftert = doublePattern 14 -sbreath = doublePattern 15 -sfoot = doublePattern 16 -sexpr = doublePattern 17 - -svel = doublePattern 18 -snote = doublePattern 19 -snoise = doublePattern 20 --- drums - - -snare d p' = note p' - |+| osc1shape zero |+| osc1kbd zero - |+| osc2shape zero |+| osc2kbd zero - |+| noise one - |+| vrel d |+| vsus zero |+| vdcy d - |+| kcutoff (p "1") - |+| dur (p "0.01") - where zero = p "0" - one = p "1" - - -kick blp p' = note p' - |+| fourpole - |+| osc1shape zero |+| osc1kbd zero - |+| osc2shape zero |+| osc2kbd zero - |+| vsus zero |+| vdcy (p "0.95") |+| vrel (p "0.5") - |+| kresonance (p "0.99") |+| kcutoff zero - |+| eamt (p "0.8") |+| emod (p "9") |+| edcy blp - |+| dur (p "0.2") - where zero = p "0" diff --git a/Sound/Tidal/VolcaBass.hs b/Sound/Tidal/VolcaBass.hs deleted file mode 100644 --- a/Sound/Tidal/VolcaBass.hs +++ /dev/null @@ -1,42 +0,0 @@ -module Sound.Tidal.VolcaBass where - -import Sound.Tidal.Stream (makeI, makeF) - -import Sound.Tidal.MIDI.Control - -bass :: ControllerShape -bass = ControllerShape { params = [ - mCC "slide" 5, - mCC "expression" 11, - mCC "octave" 40, - mCC "lforate" 41, - mCC "lfoint" 42, - mCC "pitch1" 43, - mCC "pitch2" 44, - mCC "pitch3" 45, - mCC "attack" 46, - mCC "decay" 47, - mCC "cutoffegint" 48, - mCC "gate" 49 - ], - duration = ("dur", 0.05), - velocity = ("vel", 0.5), - latency = 0.1 - } - -oscBass = toOscShape bass - -note = makeI oscBass "note" -dur = makeF oscBass "dur" -slide = makeF oscBass "slide" -expression = makeF oscBass "expression" -octave = makeF oscBass "octave" -lforate = makeF oscBass "lforate" -lfoint = makeF oscBass "lfoint" -pitch1 = makeF oscBass "pitch1" -pitch2 = makeF oscBass "pitch2" -pitch3 = makeF oscBass "pitch3" -attack = makeF oscBass "attack" -decay = makeF oscBass "decay" -cutoffegint = makeF oscBass "cutoffegint" -gate = makeF oscBass "gate" diff --git a/Sound/Tidal/VolcaBeats.hs b/Sound/Tidal/VolcaBeats.hs deleted file mode 100644 --- a/Sound/Tidal/VolcaBeats.hs +++ /dev/null @@ -1,72 +0,0 @@ -module Sound.Tidal.VolcaBeats where - -import Sound.Tidal.Stream (makeI, makeF) - -import Sound.Tidal.MIDI.Control -import Control.Applicative - -beats :: ControllerShape -beats = ControllerShape { params = [ - mCC "lKick" 40, - mCC "lSnare" 41, - mCC "lLoTom" 42, - mCC "lHiTom" 43, - mCC "lClHat" 44, - mCC "lOpHat" 45, - mCC "lClap" 46, - mCC "lClaves" 47, - mCC "lAgogo" 48, - mCC "lCrash" 49, - mCC "sClap" 50, - mCC "sClaves" 51, - mCC "sAgogo" 52, - mCC "sCrash" 53, - mCC "stutterTime" 54, - mCC "stutterDepth" 55, - mCC "tomDecay" 56, - mCC "clHatDecay" 57, - mCC "opHatDecay" 58, - mCC "hatGrain" 59 - ], - duration = ("dur", 0.05), - velocity = ("vel", 0.5), - latency = 0.1 - } - -oscBeats = toOscShape beats - -drum = (makeI oscBeats "note") . (noteN <$>) - -lbd = makeF oscBeats "lKick" -lsn = makeF oscBeats "lSnare" -llt = makeF oscBeats "lLoTom" -lht = makeF oscBeats "lHiTom" -lch = makeF oscBeats "lClHat" -loh = makeF oscBeats "lOpHat" -lcp = makeF oscBeats "lClap" -lcl = makeF oscBeats "lClaves" -lag = makeF oscBeats "lAgogo" -lcr = makeF oscBeats "lCrash" -scp = makeF oscBeats "sClap" -scl = makeF oscBeats "sClaves" -sag = makeF oscBeats "sAgogo" -scr = makeF oscBeats "sCrash" -stt = makeF oscBeats "stutterTime" -std = makeF oscBeats "stutterDepth" -dt = makeF oscBeats "tomDecay" -dch = makeF oscBeats "clHatDecay" -doh = makeF oscBeats "opHatDecay" -hg = makeF oscBeats "hatGrain" - -noteN :: String -> Int -noteN "bd" = 36 -noteN "sn" = 38 -noteN "lt" = 43 -noteN "ht" = 50 -noteN "ch" = 42 -noteN "oh" = 46 -noteN "cp" = 39 -noteN "cl" = 75 -noteN "ag" = 67 -noteN "cr" = 49 -noteN _ = 0 diff --git a/Sound/Tidal/VolcaKeys.hs b/Sound/Tidal/VolcaKeys.hs deleted file mode 100644 --- a/Sound/Tidal/VolcaKeys.hs +++ /dev/null @@ -1,50 +0,0 @@ -module Sound.Tidal.VolcaKeys where - -import Sound.Tidal.Stream (makeI, makeF) - -import Sound.Tidal.MIDI.Control - -keys :: ControllerShape -keys = ControllerShape { params = [ - mCC "portamento" 5, - mCC "expression" 11, - mCC "voice" 40, - mCC "octave" 41, - mCC "detune" 42, - mCC "vcoegint" 43, - mCC "kcutoff" 44, - mCC "vcfegint" 45, - mCC "lforate" 46, - mCC "lfopitchint" 47, - mCC "lfocutoffint" 48, - mCC "attack" 49, - mCC "decay" 50, - mCC "sustain" 51, - mCC "dtime" 52, - mCC "dfeedback" 53 - ], - duration = ("dur", 0.05), - velocity = ("vel", 0.5), - latency = 0.1 - } - -oscKeys = toOscShape keys - -note = makeI oscKeys "note" -dur = makeF oscKeys "dur" -por = makeF oscKeys "portamento" -expr = makeF oscKeys "expression" -oct = makeF oscKeys "octave" -voi = makeF oscKeys "voice" -det = makeF oscKeys "detune" -vco = makeF oscKeys "vcoegint" -ctf = makeF oscKeys "kcutoff" -vcf = makeF oscKeys "vcfegint" -lfo = makeF oscKeys "lforate" -lfop = makeF oscKeys "lfopitchint" -lfoc = makeF oscKeys "lfocutoffint" -att = makeF oscKeys "attack" -dec = makeF oscKeys "decay" -sus = makeF oscKeys "sustain" -dt = makeF oscKeys "dtime" -df = makeF oscKeys "dfeedback" diff --git a/tidal-midi.cabal b/tidal-midi.cabal --- a/tidal-midi.cabal +++ b/tidal-midi.cabal @@ -1,5 +1,5 @@ name: tidal-midi -version: 0.6 +version: 0.8 synopsis: MIDI support for tidal -- description: homepage: http://tidal.lurk.org/ @@ -16,17 +16,14 @@ 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 - Sound.Tidal.MIDI.Device + Exposed-modules: Sound.Tidal.MIDI.Context + Sound.Tidal.MIDI.VolcaBeats + Sound.Tidal.MIDI.VolcaBass + Sound.Tidal.MIDI.VolcaKeys Sound.Tidal.MIDI.Control - Sound.Tidal.SimpleSynth - Sound.Tidal.VolcaKeys - Sound.Tidal.VolcaBass - Sound.Tidal.VolcaBeats - Sound.Tidal.Blofeld - Sound.Tidal.Tetra - Sound.Tidal.Rytm - Sound.Tidal.Synthino - Sound.Tidal.MBase01 - - Build-depends: base < 5, tidal <= 0.6, PortMidi == 0.1.5.2, process, hashable, containers, hosc, time, bytestring + Sound.Tidal.MIDI.Device + Sound.Tidal.MIDI.Stream + Sound.Tidal.MIDI.Synth + Sound.Tidal.MIDI.SynthParams + + Build-depends: base < 5, tidal == 0.8, PortMidi == 0.1.6.0, time, containers, transformers