tidal 0.7.1 → 0.8
raw patch · 20 files changed
+1021/−728 lines, 20 filesdep −PortMididep −serialportdep ~containers
Dependencies removed: PortMidi, serialport
Dependency ranges changed: containers
Files
- Sound/Tidal/Context.hs +0/−4
- Sound/Tidal/Dirt.hs +103/−4
- Sound/Tidal/MIDI/Control.hs +0/−59
- Sound/Tidal/MIDI/Device.hs +0/−36
- Sound/Tidal/MIDI/Params.hs +0/−25
- Sound/Tidal/MidiStream.hs +0/−277
- Sound/Tidal/OscStream.hs +6/−4
- Sound/Tidal/Params.hs +233/−111
- Sound/Tidal/Parse.hs +44/−15
- Sound/Tidal/Pattern.hs +354/−18
- Sound/Tidal/SerialStream.hs +0/−113
- Sound/Tidal/Strategies.hs +176/−7
- Sound/Tidal/Stream.hs +10/−4
- Sound/Tidal/SuperCollider.hs +1/−1
- Sound/Tidal/Synth.hs +0/−18
- Sound/Tidal/Time.hs +9/−1
- Sound/Tidal/Transition.hs +21/−10
- Sound/Tidal/Utils.hs +41/−2
- tidal.cabal +2/−8
- tidal.el +21/−11
Sound/Tidal/Context.hs view
@@ -15,7 +15,3 @@ import Sound.Tidal.SuperCollider as C import Sound.Tidal.Params as C import Sound.Tidal.Transition as C-import Sound.Tidal.MidiStream as C-import Sound.Tidal.MIDI.Params as C-import Sound.Tidal.Synth as C-import Sound.Tidal.SerialStream as C
Sound/Tidal/Dirt.hs view
@@ -52,7 +52,10 @@ bandq_p, unit_p, loop_p,- n_p+ n_p,+ attack_p,+ hold_p,+ release_p ], cpsStamp = True, latency = 0.04@@ -69,7 +72,7 @@ superDirtBackend port = do s <- makeConnection "127.0.0.1" port superDirtSlang- return $ Backend s+ return $ Backend s (\_ _ _ -> return ()) superDirtState port = do backend <- superDirtBackend port@@ -77,7 +80,7 @@ dirtBackend = do s <- makeConnection "127.0.0.1" 7771 dirtSlang- return $ Backend s+ return $ Backend s (\_ _ _ -> return ()) -- dirtstart name = start "127.0.0.1" 7771 dirt @@ -146,21 +149,69 @@ pick :: String -> Int -> String pick name n = name ++ ":" ++ (show n) +{- | Striate is a kind of granulator, for example:++@+d1 $ striate 3 $ sound "ho ho:2 ho:3 hc"+@++This plays the loop the given number of times, but triggering+progressive portions of each sample. So in this case it plays the loop+three times, the first time playing the first third of each sample,+then the second time playing the second third of each sample, etc..+With the highhat samples in the above example it sounds a bit like+reverb, but it isn't really.++You can also use striate with very long samples, to cut it into short+chunks and pattern those chunks. This is where things get towards+granular synthesis. The following cuts a sample into 128 parts, plays+it over 8 cycles and manipulates those parts by reversing and rotating+the loops.++@+d1 $ slow 8 $ striate 128 $ sound "bev"+@+-} striate :: Int -> ParamPattern -> ParamPattern striate n p = cat $ map (\x -> off (fromIntegral x) p) [0 .. n-1] where off i p = p # begin (atom (fromIntegral i / fromIntegral n)) # end (atom (fromIntegral (i+1) / fromIntegral n)) +{-|+The `striate'` function is a variant of `striate` with an extra+parameter, which specifies the length of each part. The `striate'`+function still scans across the sample over a single cycle, but if+each bit is longer, it creates a sort of stuttering effect. For+example the following will cut the bev sample into 32 parts, but each+will be 1/16th of a sample long:++@+d1 $ slow 32 $ striate' 32 (1/16) $ sound "bev"+@++Note that `striate` uses the `begin` and `end` parameters+internally. This means that if you're using `striate` (or `striate'`)+you probably shouldn't also specify `begin` or `end`. -} striate' :: Int -> Double -> ParamPattern -> ParamPattern striate' n f p = cat $ map (\x -> off (fromIntegral x) p) [0 .. n-1] where off i p = p # begin (atom (slot * i) :: Pattern Double) # end (atom ((slot * i) + f) :: Pattern Double) slot = (1 - f) / (fromIntegral n) +{- | _not sure what this does_, variant of `striate` -} striateO :: ParamPattern -> Int -> Double -> ParamPattern striateO p n o = cat $ map (\x -> off (fromIntegral x) p) [0 .. n-1] where off i p = p # begin ((atom $ (fromIntegral i / fromIntegral n) + o) :: Pattern Double) # end ((atom $ (fromIntegral (i+1) / fromIntegral n) + o) :: Pattern Double) +{- | Just like `striate`, but also loops each sample chunk a number of times specified in the second argument.+The primed version is just like `striate'`, where the loop count is the third argument. For example:++@+d1 $ striateL' 3 0.125 4 $ sound "feel sn:2"+@++Like `striate`, these use the `begin` and `end` parameters internally, as well as the `loop` parameter for these versions.+-} striateL :: Int -> Int -> ParamPattern -> ParamPattern striateL n l p = striate n p # loop (atom $ fromIntegral l) striateL' n f l p = striate' n f p # loop (atom $ fromIntegral l)@@ -175,26 +226,74 @@ clutch :: Time -> [Pattern a] -> Pattern a clutch = clutchIn 2 +{- | crossfades between old and new pattern over given number of cycles, e.g.:++@+d1 $ sound "bd sn"++t1 (xfadeIn 16) $ sound "jvbass*3"+@++Will fade over 16 cycles from "bd sn" to "jvbass*3"+-} xfadeIn :: Time -> Time -> [ParamPattern] -> ParamPattern xfadeIn _ _ [] = silence xfadeIn _ _ (p:[]) = p xfadeIn t now (p:p':_) = overlay (p |*| gain (now ~> (slow t envEqR))) (p' |*| gain (now ~> (slow t (envEq)))) +{- | +Crossfade between old and new pattern over the next two cycles.++@+d1 $ sound "bd sn"++t1 xfade $ sound "can*3"+@++`xfade` is built with `xfadeIn` in this case taking two cycles for the fade.+-} xfade :: Time -> [ParamPattern] -> ParamPattern xfade = xfadeIn 2 +{- | Stut applies a type of delay to a pattern. It has three parameters, +which could be called depth, feedback and time. Depth is an integer+and the others floating point. This adds a bit of echo:++@+d1 $ stut 4 0.5 0.2 $ sound "bd sn"+@++The above results in 4 echos, each one 50% quieter than the last, +with 1/5th of a cycle between them. It is possible to reverse the echo:++@+d1 $ stut 4 0.5 (-0.2) $ sound "bd sn"+@+-} stut :: Integer -> Double -> Rational -> ParamPattern -> ParamPattern stut steps feedback time p = stack (p:(map (\x -> (((x%steps)*time) ~> (p |*| gain (pure $ scale (fromIntegral x))))) [1..(steps-1)])) where scale x = ((+feedback) . (*(1-feedback)) . (/(fromIntegral steps)) . ((fromIntegral steps)-)) x +{- | _not sure what this does_, variant of `stut`+-} stut' :: Integer -> Time -> (ParamPattern -> ParamPattern) -> ParamPattern -> ParamPattern stut' steps steptime f p | steps <= 0 = p | otherwise = overlay (f (steptime ~> stut' (steps-1) steptime f p)) p --- Increase comb filter to anticipate 'drop' to next pattern+{-| same as `anticipate` though it allows you to specify the number of cycles until dropping to the new pattern, e.g.:++@+d1 $ sound "jvbass(3,8)"++t1 (anticipateIn 4) $ sound "jvbass(5,8)"+@-} anticipateIn :: Time -> Time -> [ParamPattern] -> ParamPattern anticipateIn t now = wash (spread' (stut 8 0.2) (now ~> (slow t $ (toRational . (1-)) <$> envL))) t now +{- | `anticipate` is an increasing comb filter.++Build up some tension, culminating in a _drop_ to the new pattern after 8 cycles.+-} anticipate :: Time -> [ParamPattern] -> ParamPattern anticipate = anticipateIn 8
− Sound/Tidal/MIDI/Control.hs
@@ -1,59 +0,0 @@-module Sound.Tidal.MIDI.Control where--import qualified Sound.Tidal.Stream as S--import Sound.Tidal.Params-import Sound.Tidal.MIDI.Params--type RangeMapFunc = (Int, Int) -> Double -> Int--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 }--data ControllerShape = ControllerShape {- controls :: [ControlChange],- latency :: Double- }---toShape :: ControllerShape -> S.Shape-toShape cs =- let params = [dur_p, note_p, velocity_p] ++ params'- params' = [param p | p <- (controls cs)]- in S.Shape { S.params = params,- S.cpsStamp = False,- S.latency = latency cs- }--passThru :: (Int, Int) -> Double -> Int-passThru (_, _) = floor -- no sanitizing of range…--mapRange :: (Int, Int) -> Double -> Int-mapRange (low, high) = floor . (+ (fromIntegral low)) . (* ratio)- where ratio = fromIntegral $ high - low--mCC :: S.Param -> Int -> ControlChange-mCC p m = CC {param=p, 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 :: S.Param -> Int -> (Int, Int) -> Double -> ControlChange-mrNRPN p m r d = NRPN {param=p, midi=m, range=r, vdefault=d, scalef=mapRange }--toParams :: ControllerShape -> [S.Param]-toParams shape = map param (controls shape)--ctrlN :: Num b => ControllerShape -> S.Param -> Maybe b-ctrlN shape x = fmap fromIntegral $ fmap midi (paramN shape x)--paramN :: ControllerShape -> S.Param -> Maybe ControlChange-paramN shape x- | 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
− Sound/Tidal/MIDI/Device.hs
@@ -1,36 +0,0 @@-module Sound.Tidal.MIDI.Device where-import qualified Sound.PortMidi as PM--displayOutputDevices :: IO String-displayOutputDevices = do- devices <- getIndexedDevices- return $ displayDevices $ getOutputDevices devices--displayDevices :: Show a => [(a, PM.DeviceInfo)] -> String-displayDevices devices =- let indices = map (show . fst) devices- names = map ((":\t"++) . PM.name . snd) devices- 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--getDevices :: IO ([PM.DeviceInfo])-getDevices = do- PM.initialize- 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
− Sound/Tidal/MIDI/Params.hs
@@ -1,25 +0,0 @@-module Sound.Tidal.MIDI.Params where--import Sound.Tidal.Pattern-import Sound.Tidal.Stream-import Sound.Tidal.Params--dur :: Pattern Double -> ParamPattern-dur = make' VF dur_p-dur_p = F "dur" (Just 0.05)--note :: Pattern Int -> ParamPattern-note = make' VI note_p-note_p = I "note" Nothing--modwheel :: Pattern Double -> ParamPattern-modwheel = make' VF modwheel_p-modwheel_p = F "modwheel" (Just 0)--expression :: Pattern Double -> ParamPattern-expression = make' VF expression_p-expression_p = F "expression" (Just 1)--sustainpedal :: Pattern Double -> ParamPattern-sustainpedal = make' VF sustainpedal_p-sustainpedal_p = F "sustainpedal_p" (Just 0)
− Sound/Tidal/MidiStream.hs
@@ -1,277 +0,0 @@-module Sound.Tidal.MidiStream (midiStream, midiBackend, midiState, midiSetters, midiDevices) 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---- Tidal specific-import Sound.Tidal.Tempo (Tempo, cps)-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 Sound.Tidal.MIDI.Params-import qualified Sound.PortMidi as PM--data Output = Output {- conn :: PM.PMStream,- lock :: MVar (),- offset :: Double,- buffer :: MVar [PM.PMEvent]- }--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) (diff) ctrls- diff = floor $ (*1000) $ (logicalOnset - (offset s))- 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- logicalOnset = logicalOnset' change tick o 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", "note", "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 ++ "'")- sendevents 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")--useOutput outsM name lat = do- outs <- readMVar outsM -- maybe- 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"- 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- swapMVar outsM $ Map.insert name o outs- return $ Just o- Right _ -> return Nothing----makeConnection :: MVar (MidiDeviceMap) -> String -> Int -> ControllerShape -> IO (S.ToMessageFunc)-makeConnection devicesM deviceName channel cshape = do- let lat = (floor $ (*100) $ Sound.Tidal.MIDI.Control.latency cshape)- moutput <- useOutput devicesM deviceName lat- case moutput of- Just o ->- connected cshape channel deviceName o- Nothing ->- --failed o- error "Failed"--- devidM'' <- devidM' -- maybe--midiDevices :: IO (MVar (MidiDeviceMap))-midiDevices = do- newMVar $ Map.fromList []--midiBackend d n c cs = do- s <- makeConnection d n c cs- return $ Backend s--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)----- actual midi interaction-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 -> ControllerShape -> CLong -> CULong -> 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 :: 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 :: (Show s, RealFrac s) => Output -> ControllerShape -> CLong -> (CLong, CLong, s) -> CULong -> MidiMap -> 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 ()----- 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 -> ControlChange -> CLong -> CULong -> 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--- 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----- 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- 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)- return (Left Output { conn=dev, lock=sem, offset=syncedNow, 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.encodeMsg $ PM.PMMsg (encodeChannel ch st) (n) (v)---- 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
Sound/Tidal/OscStream.hs view
@@ -29,15 +29,17 @@ toOscMap :: ParamMap -> OscMap toOscMap m = Map.map (toOscDatum) (Map.mapMaybe (id) m) - -- constructs and sends an Osc Message according to the given slang -- and other params - this is essentially the same as the former -- toMessage in Stream.hs send s slang shape change tick (o, 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+ 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, Just v) -> [string (name k), v] ) $ filter (isJust . snd) $ Map.assocs m)
Sound/Tidal/Params.hs view
@@ -4,11 +4,13 @@ import Sound.Tidal.Pattern import qualified Data.Map as Map import Sound.Tidal.Utils+import Control.Applicative make' :: (a -> Value) -> Param -> Pattern a -> ParamPattern make' toValue par p = fmap (\x -> Map.singleton par (defaultV x)) p where defaultV a = Just $ toValue a +-- | group multiple params into one grp :: [Param] -> Pattern String -> ParamPattern grp [] _ = silence grp params p = (fmap lookupPattern p)@@ -19,140 +21,260 @@ toPV param@(S _ _) s = (param, (Just $ VS s)) toPV param@(F _ _) s = (param, (Just $ VF $ read s)) toPV param@(I _ _) s = (param, (Just $ VI $ read s))--sound :: Pattern String -> ParamPattern-sound = grp [s_p, n_p]---- "s" stands for sample, or synth-s :: Pattern String -> ParamPattern-s = make' VS s_p-s_p = S "s" Nothing---- "n" stands for sample number, or note-n :: Pattern Int -> ParamPattern-n = make' VI n_p-n_p = I "n" (Just 0)--nudge :: Pattern Double -> ParamPattern-nudge = make' VF nudge_p-nudge_p = (F "nudge" (Just 0))--offset :: Pattern Double -> ParamPattern-offset = make' VF offset_p-offset_p = F "offset" (Just 0)--begin :: Pattern Double -> ParamPattern-begin = make' VF begin_p-begin_p = F "begin" (Just 0)--end :: Pattern Double -> ParamPattern-end = make' VF end_p-end_p = F "end" (Just 1)--speed :: Pattern Double -> ParamPattern-speed = make' VF speed_p-speed_p = F "speed" (Just 1)+{- | -pan :: Pattern Double -> ParamPattern-pan = make' VF pan_p-pan_p = F "pan" (Just 0.5)+a pattern of strings representing sound sample names (required). -velocity :: Pattern Double -> ParamPattern-velocity = make' VF velocity_p-velocity_p = F "velocity" (Just 0.5)+`sound` is a combination of the `s` and `n` parameters to allow specifying both sample name and sample variation in one: -vowel :: Pattern String -> ParamPattern-vowel = make' VS vowel_p-vowel_p = S "vowel" (Just "")+@+d1 $ sound "bd:2 sn:0"+@ -cutoff :: Pattern Double -> ParamPattern-cutoff = make' VF cutoff_p-cutoff_p = F "cutoff" (Just 0)+is essentially the same as: -resonance :: Pattern Double -> ParamPattern-resonance = make' VF resonance_p-resonance_p = F "resonance" (Just 0)+@+d1 $ s "bd sn" # n "2 0"+@+-}+sound :: Pattern String -> ParamPattern+sound = grp [s_p, n_p] -accelerate :: Pattern Double -> ParamPattern-accelerate = make' VF accelerate_p-accelerate_p = F "accelerate" (Just 0)+pF name defaultV = (make' VF param, param)+ where param = F name defaultV+pI name defaultV = (make' VI param, param)+ where param = I name defaultV+pS name defaultV = (make' VS param, param)+ where param = S name defaultV+-- | a pattern of numbers that speed up (or slow down) samples while they play.+(accelerate, accelerate_p) = pF "accelerate" (Just 0)+-- | a pattern of numbers to specify the attack time (in seconds) of an envelope applied to each sample. Only takes effect if `release` is also specified.+(attack, attack_p) = pF "attack" (Just (-1))+-- | a pattern of numbers from 0 to 1. Sets the center frequency of the band-pass filter.+(bandf, bandf_p) = pF "bandf" (Just 0)+-- | a pattern of numbers from 0 to 1. Sets the q-factor of the band-pass filter.+(bandq, bandq_p) = pF "bandq" (Just 0)+{- | a pattern of numbers from 0 to 1. Skips the beginning of each sample, e.g. `0.25` to cut off the first quarter from each sample. -shape :: Pattern Double -> ParamPattern-shape = make' VF shape_p-shape_p = F "shape" (Just 0)+Using `begin "-1"` combined with `cut "-1"` means that when the sample cuts itself it will begin playback from where the previous one left off, so it will sound like one seamless sample. This allows you to apply a synth param across a long sample in a way similar to `chop`: -kriole :: Pattern Int -> ParamPattern-kriole = make' VI kriole_p-kriole_p = I "kriole" (Just 0)+@+cps 0.5 -gain :: Pattern Double -> ParamPattern-gain = make' VF gain_p-gain_p = F "gain" (Just 1)+d1 $ sound "breaks125*8" # unit "c" # begin "-1" # cut "-1" # coarse "1 2 4 8 16 32 64 128"+@ -cut :: Pattern Int -> ParamPattern-cut = make' VI cut_p-cut_p = I "cut" (Just (0))+This will play the `breaks125` sample and apply the changing `coarse` parameter over the sample. Compare to: -delay :: Pattern Double -> ParamPattern-delay = make' VF delay_p-delay_p = F "delay" (Just (0))+@+d1 $ (chop 8 $ sounds "breaks125") # unit "c" # coarse "1 2 4 8 16 32 64 128"+@ -delaytime :: Pattern Double -> ParamPattern-delaytime = make' VF delaytime_p-delaytime_p = F "delaytime" (Just (-1))+which performs a similar effect, but due to differences in implementation sounds different.+-}+(begin, begin_p) = pF "begin" (Just 0)+-- | choose the physical channel the pattern is sent to, this is super dirt specific+(channel, channel_p) = pI "channel" Nothing+(clhatdecay, clhatdecay_p) = pF "clhatdecay" (Just 0)+-- | fake-resampling, a pattern of numbers for lowering the sample rate, i.e. 1 for original 2 for half, 3 for a third and so on.+(coarse, coarse_p) = pI "coarse" (Just 0)+-- | bit crushing, a pattern of numbers from 1 (for drastic reduction in bit-depth) to 16 (for barely no reduction).+(crush, crush_p) = pF "crush" (Just 0)+{- |+In the style of classic drum-machines, `cut` will stop a playing sample as soon as another samples with in same cutgroup is to be played. -delayfeedback :: Pattern Double -> ParamPattern-delayfeedback = make' VF delayfeedback_p-delayfeedback_p = F "delayfeedback" (Just (-1))+An example would be an open hi-hat followed by a closed one, essentially muting the open. -crush :: Pattern Double -> ParamPattern-crush = make' VF crush_p-crush_p = F "crush" (Just 0)+@+d1 $ stack [+ sound "bd",+ sound "~ [~ [ho:2 hc/2]]" # cut "1"+ ]+@ -coarse :: Pattern Int -> ParamPattern-coarse = make' VI coarse_p-coarse_p = I "coarse" (Just 0)+This will mute the open hi-hat every second cycle when the closed one is played. -hcutoff :: Pattern Double -> ParamPattern-hcutoff = make' VF hcutoff_p-hcutoff_p = F "hcutoff" (Just 0)+Using `cut` with negative values will only cut the same sample. This is useful to cut very long samples -hresonance :: Pattern Double -> ParamPattern-hresonance = make' VF hresonance_p-hresonance_p = F "hresonance" (Just 0)+@+d1 $ sound "[bev, [ho:3](3,8)]" # cut "-1"+@ -bandf :: Pattern Double -> ParamPattern-bandf = make' VF bandf_p-bandf_p = F "bandf" (Just 0)+Using `cut "0"` is effectively _no_ cutgroup.+-}+(cut, cut_p) = pI "cut" (Just 0)+-- | a pattern of numbers from 0 to 1. Applies the cutoff frequency of the low-pass filter.+(cutoff, cutoff_p) = pF "cutoff" (Just 0)+(cutoffegint, cutoffegint_p) = pF "cutoffegint" (Just 0)+(decay, decay_p) = pF "decay" (Just 0)+-- | a pattern of numbers from 0 to 1. Sets the level of the delay signal.+(delay, delay_p) = pF "delay" (Just 0)+-- | a pattern of numbers from 0 to 1. Sets the amount of delay feedback.+(delayfeedback, delayfeedback_p) = pF "delayfeedback" (Just (-1))+-- | a pattern of numbers from 0 to 1. Sets the length of the delay.+(delaytime, delaytime_p) = pF "delaytime" (Just (-1))+(detune, detune_p) = pF "detune" (Just 0)+-- | when set to `1` will disable all reverb for this pattern. See `room` and `size` for more information about reverb.+(dry, dry_p) = pF "dry" (Just 0)+{- the same as `begin`, but cuts the end off samples, shortening them;+ e.g. `0.75` to cut off the last quarter of each sample.+-}+(end, end_p) = pF "end" (Just 1)+-- | a pattern of numbers that specify volume. Values less than 1 make the sound quieter. Values greater than 1 make the sound louder.+(gain, gain_p) = pF "gain" (Just 1)+(gate, gate_p) = pF "gate" (Just 0)+(hatgrain, hatgrain_p) = pF "hatgrain" (Just 0)+-- | a pattern of numbers from 0 to 1. Applies the cutoff frequency of the high-pass filter.+(hcutoff, hcutoff_p) = pF "hcutoff" (Just 0)+-- | a pattern of numbers to specify the hold time (in seconds) of an envelope applied to each sample. Only takes effect if `attack` and `release` are also specified.+(hold, hold_p) = pF "hold" (Just 0)+-- | a pattern of numbers from 0 to 1. Applies the resonance of the high-pass filter.+(hresonance, hresonance_p) = pF "hresonance" (Just 0)+(kriole, kriole_p) = pI "kriole" (Just 0)+(lagogo, lagogo_p) = pF "lagogo" (Just 0)+(lclap, lclap_p) = pF "lclap" (Just 0)+(lclaves, lclaves_p) = pF "lclaves" (Just 0)+(lclhat, lclhat_p) = pF "lclhat" (Just 0)+(lcrash, lcrash_p) = pF "lcrash" (Just 0)+(lfo, lfo_p) = pF "lfo" (Just 0)+(lfocutoffint, lfocutoffint_p) = pF "lfocutoffint" (Just 0)+(lfodelay, lfodelay_p) = pF "lfodelay" (Just 0)+(lfoint, lfoint_p) = pF "lfoint" (Just 0)+(lfopitchint, lfopitchint_p) = pF "lfopitchint" (Just 0)+(lfoshape, lfoshape_p) = pF "lfoshape" (Just 0)+(lfosync, lfosync_p) = pF "lfosync" (Just 0)+(lhitom, lhitom_p) = pF "lhitom" (Just 0)+(lkick, lkick_p) = pF "lkick" (Just 0)+(llotom, llotom_p) = pF "llotom" (Just 0)+{- | A pattern of numbers. Specifies whether delaytime is calculated relative to cps. When set to 1, delaytime is a direct multiple of a cycle.+-}+(lock, lock_p) = pF "lock" (Just 0)+-- | loops the sample (from `begin` to `end`) the specified number of times.+(loop, loop_p) = pI "loop" (Just 1)+(lophat, lophat_p) = pF "lophat" (Just 0)+(lsnare, lsnare_p) = pF "lsnare" (Just 0)+-- | specifies the sample variation to be used+(n, n_p) = pI "n" (Just 0)+{- |+Pushes things forward (or backwards within built-in latency) in time. Allows for nice things like _swing_ feeling: -bandq :: Pattern Double -> ParamPattern-bandq = make' VF bandq_p-bandq_p = F "bandq" (Just 0)+@+d1 $ stack [+ sound "bd bd/4",+ sound "hh(5,8)"+ ] # nudge "[0 0.04]*4"+@ -unit :: Pattern String -> ParamPattern-unit = make' VS unit_p-unit_p = S "unit" (Just "rate")+Low values will give a more _human_ feeling, high values might result in quite the contrary.+-}+(nudge, nudge_p) = pF "nudge" (Just 0)+(octave, octave_p) = pI "octave" (Just 3)+(offset, offset_p) = pF "offset" (Just 0)+(ophatdecay, ophatdecay_p) = pF "ophatdecay" (Just 0)+{- | a pattern of numbers. An `orbit` is a global parameter context for patterns. Patterns with the same orbit will share hardware output bus offset and global effects, e.g. reverb and delay. The maximum number of orbits is specified in the superdirt startup, numbers higher than maximum will wrap around.+-}+(orbit, orbit_p) = pI "orbit" (Just 0)+-- | a pattern of numbers between 0 and 1, from left to right (assuming stereo).+(pan, pan_p) = pF "pan" (Just 0.5)+(pitch1, pitch1_p) = pF "pitch1" (Just 0)+(pitch2, pitch2_p) = pF "pitch2" (Just 0)+(pitch3, pitch3_p) = pF "pitch3" (Just 0)+(portamento, portamento_p) = pF "portamento" (Just 0)+-- | a pattern of numbers to specify the release time (in seconds) of an envelope applied to each sample. Only takes effect if `attack` is also specified.+(release, release_p) = pF "release" (Just (-1))+-- | a pattern of numbers from 0 to 1. Specifies the resonance of the low-pass filter.+(resonance, resonance_p) = pF "resonance" (Just 0)+-- | a pattern of numbers from 0 to 1. Sets the level of reverb.+(room, room_p) = pF "room" Nothing+(sagogo, sagogo_p) = pF "sagogo" (Just 0)+(sclap, sclap_p) = pF "sclap" (Just 0)+(sclaves, sclaves_p) = pF "sclaves" (Just 0)+(scrash, scrash_p) = pF "scrash" (Just 0)+(semitone, semitone_p) = pF "semitone" (Just 0)+-- | wave shaping distortion, a pattern of numbers from 0 for no distortion up to 1 for loads of distortion.+(shape, shape_p) = pF "shape" (Just 0)+-- | a pattern of numbers from 0 to 1. Sets the perceptual size (reverb time) of the `room` to be used in reverb.+(size, size_p) = pF "size" Nothing+(slide, slide_p) = pF "slide" (Just 0)+-- | a pattern of numbers from 0 to 1, which changes the speed of sample playback, i.e. a cheap way of changing pitch+(speed, speed_p) = pF "speed" (Just 1)+-- | a pattern of strings. Selects the sample to be played.+(s, s_p) = pS "s" Nothing+(stutterdepth, stutterdepth_p) = pF "stutterdepth" (Just 0)+(stuttertime, stuttertime_p) = pF "stuttertime" (Just 0)+(sustain, sustain_p) = pF "sustain" (Just 0)+(tomdecay, tomdecay_p) = pF "tomdecay" (Just 0)+-- | only accepts a value of "c". Used in conjunction with `speed`, it time-stretches a sample to fit in a cycle.+(unit, unit_p) = pS "unit" (Just "rate")+(velocity, velocity_p) = pF "velocity" (Just 0.5)+(vcfegint, vcfegint_p) = pF "vcfegint" (Just 0)+(vcoegint, vcoegint_p) = pF "vcoegint" (Just 0)+(voice, voice_p) = pF "voice" (Just 0)+-- | formant filter to make things sound like vowels, a pattern of either `a`, `e`, `i`, `o` or `u`. Use a rest (`~`) for no effect.+(vowel, vowel_p) = pS "vowel" (Just "") -loop :: Pattern Int -> ParamPattern-loop = make' VI loop_p-loop_p = I "loop" (Just 1)+-- MIDI-specific params -channel :: Pattern Int -> ParamPattern-channel = make' VI channel_p-channel_p = I "channel" Nothing+(dur,dur_p) = pF "dur" (Just 0.05)+(modwheel,modwheel_p) = pF "modwheel" (Just 0)+(expression,expression_p) = pF "expression" (Just 1)+(sustainpedal,sustainpedal_p) = pF "sustainpedal" (Just 0) -room :: Pattern Double -> ParamPattern-room = make' VF room_p-room_p = F "room" Nothing+-- aliases+att = attack+chdecay = clhatdecay+ctf = cutoff+ctfg = cutoffegint+delayfb = delayfeedback+delayt = delaytime+det = detune+gat = gate_p+hg = hatgrain+lag = lagogo+lbd = lkick+lch = lclhat+lcl = lclaves+lcp = lclap+lcr = lcrash+lfoc = lfocutoffint+lfoi = lfoint+lfop = lfopitchint+lht = lhitom+llt = llotom+loh = lophat+lsn = lsnare+ohdecay = ophatdecay+pit1 = pitch1+pit2 = pitch2+pit3 = pitch3+por = portamento+sag = sagogo+scl = sclaves+scp = sclap+scr = scrash+sld = slide+std = stutterdepth+stt = stuttertime+sus = sustain+tdecay = tomdecay+vcf = vcfegint+vco = vcoegint+voi = voice -size :: Pattern Double -> ParamPattern-size = make' VF size_p-size_p = F "size" Nothing+note = n+midinote = n . ((subtract 60) <$>) -dry :: Pattern Double -> ParamPattern-dry = make' VF dry_p-dry_p = F "dry" (Just 0)+drum = n . (drumN <$>) -orbit :: Pattern Int -> ParamPattern-orbit = make' VI orbit_p-orbit_p = I "orbit" (Just 0)+drumN :: String -> Int+drumN "bd" = 36+drumN "sn" = 38+drumN "lt" = 43+drumN "ht" = 50+drumN "ch" = 42+drumN "oh" = 46+drumN "cp" = 39+drumN "cl" = 75+drumN "ag" = 67+drumN "cr" = 49+drumN _ = 0
Sound/Tidal/Parse.hs view
@@ -33,6 +33,9 @@ instance Parseable Int where p = parseRhythm pInt +instance Parseable Integer where+ p = (fromIntegral <$>) <$> parseRhythm pInt+ instance Parseable Rational where p = parseRhythm pRational @@ -111,7 +114,8 @@ part <- pE part part <- pRand part spaces- parts <- pReplicate part+ parts <- pStretch part+ <|> pReplicate part spaces return $ parts @@ -151,18 +155,28 @@ do oneOf "f0" return $ atom False +parseIntNote :: Parser Int+parseIntNote = do s <- sign+ i <- choice [integer, parseNote]+ return $ applySign s $ fromIntegral i++parseInt :: Parser Int+parseInt = do s <- sign+ i <- integer+ return $ applySign s $ fromIntegral i+ pInt :: Parser (Pattern Int)-pInt = do s <- sign- i <- choice [integer, midinote]- return $ atom (applySign s $ fromIntegral i)+pInt = do i <- parseIntNote+ return $ atom i -midinote :: Parser Integer-midinote = do n <- notenum- modifiers <- many noteModifier- octave <- option 5 natural- let n' = fromIntegral $ foldr (+) n modifiers- return $ n' + octave*12- where notenum = choice [char 'c' >> return 0,+parseNote :: Integral a => Parser a+parseNote = do n <- notenum+ modifiers <- many noteModifier+ octave <- option 5 natural+ let n' = foldr (+) n modifiers+ return $ fromIntegral $ n' + ((octave-5)*12)+ where+ notenum = choice [char 'c' >> return 0, char 'd' >> return 2, char 'e' >> return 4, char 'f' >> return 5,@@ -175,6 +189,9 @@ char 'n' >> return 0 ] +fromNote :: Integral c => Pattern String -> Pattern c+fromNote p = (\s -> either (const 0) id $ parse parseNote "" s) <$> p+ pColour :: Parser (Pattern ColourD) pColour = do name <- many1 letter <?> "colour name" colour <- readColourName name <?> "known colour"@@ -219,10 +236,22 @@ pReplicate :: Pattern a -> Parser ([Pattern a])-pReplicate thing = do extras <- many $ do char '!'- spaces- pRand thing- return (thing:extras)+pReplicate thing =+ do extras <- many $ do char '!'+ -- if a number is given (without a space)+ -- replicate that number of times+ n <- ((read <$> many1 digit) <|> return 1)+ spaces+ thing' <- pRand thing+ return $ replicate (fromIntegral n) thing'+ return (thing:concat extras)+++pStretch :: Pattern a -> Parser ([Pattern a])+pStretch thing =+ do char '@'+ n <- ((read <$> many1 digit) <|> return 1)+ return $ map (\x -> zoom (x%n,(x+1)%n) thing) [0 .. (n-1)] pRatio :: Parser (Rational) pRatio = do n <- natural <?> "numerator"
Sound/Tidal/Pattern.hs view
@@ -33,11 +33,17 @@ instance (Show a) => Show (Pattern a) where show p@(Pattern _) = intercalate " " $ map showEvent $ arc p (0, 1) +-- | converts a ratio into human readable string, e.g. @1/3@+showTime :: (Show a, Integral a) => Ratio a -> String showTime t | denominator t == 1 = show (numerator t) | otherwise = show (numerator t) ++ ('/':show (denominator t)) +-- | converts a time arc into human readable string, e.g. @1/3 3/4@+showArc :: Arc -> String showArc a = concat[showTime $ fst a, (' ':showTime (snd a))] +-- | converts an event into human readable string, e.g. @("bd" 1/4 2/3)@+showEvent :: (Show a) => Event a -> String showEvent (a, b, v) | a == b = concat["(",show v, (' ':showArc a), ")"@@ -234,12 +240,48 @@ (~>) :: Time -> Pattern a -> Pattern a (~>) = (<~) . (0-) +{- | (The above means that `brak` is a function from patterns of any type,+to a pattern of the same type.)++Make a pattern sound a bit like a breakbeat++Example:++@+d1 $ sound (brak "bd sn kurt")+@+-} brak :: Pattern a -> Pattern a brak = when ((== 1) . (`mod` 2)) (((1%4) ~>) . (\x -> cat [x, silence])) +{- | Divides a pattern into a given number of subdivisions, plays the subdivisions+in order, but increments the starting subdivision each cycle. The pattern+wraps to the first subdivision after the last subdivision is played.++Example:++@+d1 $ iter 4 $ sound "bd hh sn cp"+@++This will produce the following over four cycles:++@+bd hh sn cp+hh sn cp bd+sn cp bd hh+cp bd hh sn+@++There is also `iter'`, which shifts the pattern in the opposite direction.++-} iter :: Int -> Pattern a -> Pattern a iter n p = slowcat $ map (\i -> ((fromIntegral i)%(fromIntegral n)) <~ p) [0 .. n] +iter' :: Int -> Pattern a -> Pattern a+iter' n p = slowcat $ map (\i -> ((fromIntegral i)%(fromIntegral n)) ~> p) [0 .. n]+ -- | @rev p@ returns @p@ with the event positions in each cycle -- reversed (or mirrored). rev :: Pattern a -> Pattern a@@ -268,6 +310,20 @@ playFor :: Time -> Time -> Pattern a -> Pattern a playFor s e = playWhen (\t -> and [t >= s, t < e]) +{- | There is a similar function named `seqP` which allows you to define when+a sound within a list starts and ends. The code below contains three+separate patterns in a "stack", but each has different start times +(zero cycles, eight cycles, and sixteen cycles, respectively). All+patterns stop after 128 cycles:++@+d1 $ seqP [ + (0, 128, sound "bd bd*2"), + (8, 128, sound "hh*2 [sn cp] cp future*4"), + (16, 128, sound (samples "arpy*8" (run 16)))+]+@+-} seqP :: [(Time, Time, Pattern a)] -> Pattern a seqP = stack . (map (\(s, e, p) -> playFor s e ((sam s) ~> p))) @@ -390,12 +446,81 @@ fadeIn :: Time -> Pattern a -> Pattern a fadeIn n = spread' (degradeBy) (slow n $ (1-) <$> envL) +{- | (The above is difficult to describe, if you don't understand Haskell,+just read the description and examples..)++The `spread` function allows you to take a pattern transformation+which takes a parameter, such as `slow`, and provide several+parameters which are switched between. In other words it 'spreads' a+function across several values.++Taking a simple high hat loop as an example:++@+d1 $ sound "ho ho:2 ho:3 hc"+@++We can slow it down by different amounts, such as by a half:++@+d1 $ slow 2 $ sound "ho ho:2 ho:3 hc"+@++Or by four thirds (i.e. speeding it up by a third; `4%3` means four over+three):++@+d1 $ slow (4%3) $ sound "ho ho:2 ho:3 hc"+@++But if we use `spread`, we can make a pattern which alternates between+the two speeds:++@+d1 $ spread slow [2,4%3] $ sound "ho ho:2 ho:3 hc"+@++-} spread :: (a -> t -> Pattern b) -> [a] -> t -> Pattern b spread f xs p = cat $ map (\x -> f x p) xs +{- | `slowspread` takes a list of pattern transforms and applies them one at a time, per cycle, +then repeats.++Example:++@+d1 $ slowspread ($) [density 2, rev, slow 2, striate 3, (# speed "0.8")] + $ sound "[bd*2 [~ bd]] [sn future]*2 cp jvbass*4"+@++Above, the pattern will have these transforms applied to it, one at a time, per cycle:++* cycle 1: `density 2` - pattern will increase in speed+* cycle 2: `rev` - pattern will be reversed+* cycle 3: `slow 2` - pattern will decrease in speed+* cycle 4: `striate 3` - pattern will be granualized+* cycle 5: `(# speed "0.8")` - pattern samples will be played back more slowly++After `(# speed "0.8")`, the transforms will repeat and start at `density 2` again.+-} slowspread :: (a -> t -> Pattern b) -> [a] -> t -> Pattern b slowspread f xs p = slowcat $ map (\x -> f x p) xs +{- | There's a version of this function, `spread'` (pronounced "spread prime"), which takes a *pattern* of parameters, instead of a list:++@+d1 $ spread' slow "2 4%3" $ sound "ho ho:2 ho:3 hc"+@++This is quite a messy area of Tidal - due to a slight difference of+implementation this sounds completely different! One advantage of+using `spread'` though is that you can provide polyphonic parameters, e.g.:++@+d1 $ spread' slow "[2 4%3, 3]" $ sound "ho ho:2 ho:3 hc"+@+-} spread' :: (a -> Pattern b -> Pattern c) -> Pattern a -> Pattern b -> Pattern c spread' f timepat pat = Pattern $ \r -> concatMap (\(_,r', x) -> (arc (f x pat) r')) (rs r)@@ -444,17 +569,73 @@ where apply a | test (floor $ fst a) = (arc $ f1 p) a | otherwise = (arc $ f2 p) a +{-|++`rand` generates a continuous pattern of (pseudo-)random, floating point numbers between `0` and `1`.++@+d1 $ sound "bd*8" # pan rand+@++pans bass drums randomly++@+d1 $ sound "sn sn ~ sn" # gain rand+@++makes the snares' randomly loud and quiet.++Numbers coming from this pattern are random, but dependent on time. So if you reset time via `cps (-1)` the random pattern will emit the exact same _random_ numbers again.++In cases where you need two different random patterns, you can shift one of them around to change the time from which the _random_ pattern is read, note the difference:++@+d1 $ jux (|+| gain rand) $ sound "sn sn ~ sn" # gain rand+@++and with the juxed version shifted backwards for 1024 cycles:++@+d1 $ jux (|+| ((1024 <~) $ gain rand)) $ sound "sn sn ~ sn" # gain rand+@+-} rand :: Pattern Double rand = Pattern $ \a -> [(a, a, timeToRand $ (midPoint a))] timeToRand t = fst $ randomDouble $ pureMT $ floor $ (*1000000) t +{- | Just like `rand` but for integers, `irand n` generates a pattern of (pseudo-)random integers between `0` to `n-1` inclusive. Notably used to pick a random+samples from a folder:++@+d1 $ sound (samples "drum*4" (irand 5))+@+-} irand :: Int -> Pattern Int irand i = (floor . (* (fromIntegral i))) <$> rand +{- | Randomly picks an element from the given list++@+d1 $ sound (samples "xx(3,8)" (tom $ choose ["a", "e", "g", "c"]))+@++plays a melody randomly choosing one of the four notes: `"a"`, `"e"`, `"g"`, `"c"` +-} choose :: [a] -> Pattern a choose xs = (xs !!) <$> (irand $ length xs) +{- |+Similar to `degrade` `degradeBy` allows you to control the percentage of events that+are removed. For example, to remove events 90% of the time:++@+d1 $ slow 2 $ degradeBy 0.9 $ sound "[[[feel:5*8,feel*3] feel:3*8], feel*4]"+ # accelerate "-6"+ # speed "2"+@++-} degradeBy :: Double -> Pattern a -> Pattern a degradeBy x p = unMaybe $ (\a f -> toMaybe (f > x) a) <$> p <*> rand where toMaybe False _ = Nothing@@ -467,6 +648,23 @@ toMaybe True a = Just a unMaybe = (fromJust <$>) . filterValues isJust +{- | Use `sometimesBy` to apply a given function "sometimes". For example, the +following code results in `density 2` being applied about 25% of the time:++@+d1 $ sometimesBy 0.25 (density 2) $ sound "bd*8"+@++There are some aliases as well:++@+sometimes = sometimesBy 0.5+often = sometimesBy 0.75+rarely = sometimesBy 0.25+almostNever = sometimesBy 0.1+almostAlways = sometimesBy 0.9+@+-} sometimesBy :: Double -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a sometimesBy x f p = overlay (degradeBy x p) (f $ unDegradeBy x p) @@ -476,6 +674,27 @@ almostNever = sometimesBy 0.1 almostAlways = sometimesBy 0.9 +{- | `degrade` randomly removes events from a pattern 50% of the time:++@+d1 $ slow 2 $ degrade $ sound "[[[feel:5*8,feel*3] feel:3*8], feel*4]"+ # accelerate "-6"+ # speed "2"+@++The shorthand syntax for `degrade` is a question mark: `?`. Using `?`+will allow you to randomly remove events from a portion of a pattern:++@+d1 $ slow 2 $ sound "bd ~ sn bd ~ bd? [sn bd?] ~"+@++You can also use `?` to randomly remove events from entire sub-patterns:++@+d1 $ slow 2 $ sound "[[[feel:5*8,feel*3] feel:3*8]?, feel*4]"+@+-} degrade :: Pattern a -> Pattern a degrade = degradeBy 0.5 @@ -485,11 +704,37 @@ wedge :: Time -> Pattern a -> Pattern a -> Pattern a wedge t p p' = overlay (densityGap (1/t) p) (t ~> densityGap (1/(1-t)) p') +{- | `whenmod` has a similar form and behavior to `every`, but requires an +additional number. Applies the function to the pattern, when the+remainder of the current loop number divided by the first parameter,+is less than the second parameter.++For example the following makes every other block of four loops twice+as dense:++@+d1 $ whenmod 8 4 (density 2) (sound "bd sn kurt")+@+-} whenmod :: Int -> Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a whenmod a b = Sound.Tidal.Pattern.when ((\t -> (t `mod` a) >= b )) +{- |+@ superimpose f p = stack [p, f p]+@ +`superimpose` plays a modified version of a pattern at the same time as the original pattern,+resulting in two patterns being played at the same time.++@+d1 $ superimpose (density 2) $ sound "bd sn [cp ht] hh"+d1 $ superimpose ((# speed "2") . (0.125 <~)) $ sound "bd sn cp hh"+@++-}+superimpose f p = stack [p, f p]+ -- | @splitQueries p@ wraps `p` to ensure that it does not get -- queries that span arcs. For example `arc p (0.5, 1.5)` would be -- turned into two queries, `(0.5,1)` and `(1,1.5)`, and the results@@ -498,12 +743,32 @@ splitQueries :: Pattern a -> Pattern a splitQueries p = Pattern $ \a -> concatMap (arc p) $ arcCycles a +{- | Truncates a pattern so that only a fraction of the pattern is played. +The following example plays only the first three quarters of the pattern:++@+d1 $ trunc 0.75 $ sound "bd sn*2 cp hh*4 arpy bd*2 cp bd*2"+@+-} trunc :: Time -> Pattern a -> Pattern a trunc t p = slow t $ splitQueries $ p' where p' = Pattern $ \a -> mapArcs (stretch . trunc') $ arc p (trunc' a) trunc' (s,e) = (min s ((sam s) + t), min e ((sam s) + t)) stretch (s,e) = (sam s + ((s - sam s) / t), sam s + ((e - sam s) / t)) +{- | Plays a portion of a pattern, specified by a beginning and end arc of time. +The new resulting pattern is played over the time period of the original pattern:++@+d1 $ zoom (0.25, 0.75) $ sound "bd*2 hh*3 [sn bd]*2 drum"+@++In the pattern above, `zoom` is used with an arc from 25% to 75%. It is equivalent to this pattern:++@+d1 $ sound "hh*3 [sn bd]*2"+@+-} zoom :: Arc -> Pattern a -> Pattern a zoom a@(s,e) p = splitQueries $ withResultArc (mapCycle ((/d) . (subtract s))) $ withQueryArc (mapCycle ((+s) . (*d))) p where d = e-s@@ -516,9 +781,20 @@ sliceArc a@(s,e) p | s >= e = silence | otherwise = compress a $ zoom a p --- @within@ uses @compress@ and @zoom to apply @f@ to only part of pattern @p@--- for example, @within (1%2) (3%4) ((1%8) <~) "bd sn bd cp"@ would shift only--- the second @bd@+{- |+Use `within` to apply a function to only a part of a pattern. For example, to+apply `density 2` to only the first half of a pattern:++@+d1 $ within (0, 0.5) (density 2) $ sound "bd*2 sn lt mt hh hh hh hh"+@++Or, to apply `(# speed "0.5") to only the last quarter of a pattern:++@+d1 $ within (0.75, 1) (# speed "0.5") $ sound "bd*2 sn lt mt hh hh hh hh"+@+-} within :: Arc -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a within (s,e) f p = stack [sliceArc (0,s) p, compress (s,e) $ f $ zoom (s,e) p,@@ -639,33 +915,51 @@ randcat :: [Pattern a] -> Pattern a randcat ps = spread' (<~) (discretise 1 $ ((%1) . fromIntegral) <$> irand (length ps)) (slowcat ps) --- | @toMIDI p@: converts a pattern of human-readable pitch names into--- MIDI pitch numbers. For example, @"cs4"@ will be rendered as @"49"@.--- Omitting the octave number will create a pitch in the fifth octave--- (@"cf"@ -> @"cf5"@). Pitches can be decorated using:+-- | @fromNote p@: converts a pattern of human-readable pitch names+-- into pitch numbers. For example, @"cs2"@ will be parsed as C Sharp+-- in the 2nd octave with the result of @11@, and @"b-3"@ as+-- @-25@. Pitches can be decorated using: ----- * s = Sharp, a half-step above (@"gs4"@)--- * f = Flat, a half-step below (@"gf4"@)--- * n = Natural, no decoration (@"g4" and "gn4"@ are equivalent)--- * ss = Double sharp, a whole step above (@"gss4"@)--- * ff = Double flat, a whole step below (@"gff4"@)+-- * s = Sharp, a half-step above (@"gs-1"@)+-- * f = Flat, a half-step below (@"gf-1"@)+-- * n = Natural, no decoration (@"g-1" and "gn-1"@ are equivalent)+-- * ss = Double sharp, a whole step above (@"gss-1"@)+-- * ff = Double flat, a whole step below (@"gff-1"@) ----- This function also has a shorter alias @tom@.+-- Note that TidalCycles now assumes that middle C is represented by+-- the value 0, rather than the previous value of 60. This function+-- is similar to previously available functions @tom@ and @toMIDI@,+-- but the default octave is now 0 rather than 5.+{-++definition moved to Parse.hs ..+ toMIDI :: Pattern String -> Pattern Int toMIDI p = fromJust <$> (filterValues (isJust) (noteLookup <$> p)) where noteLookup :: String -> Maybe Int noteLookup [] = Nothing- noteLookup s | not (last s `elem` ['0' .. '9']) = noteLookup (s ++ "5")+ noteLookup s | not (last s `elem` ['0' .. '9']) = noteLookup (s ++ "0") | not (isLetter (s !! 1)) = noteLookup((head s):'n':(tail s)) | otherwise = parse s parse x = (\a b c -> a+b+c) <$> pc x <*> sym x <*> Just(12*digitToInt (last x)) pc x = lookup (head x) [('c',0),('d',2),('e',4),('f',5),('g',7),('a',9),('b',11)] sym x = lookup (init (tail x)) [("s",1),("f",-1),("n",0),("ss",2),("ff",-2)]+-} -- | @tom p@: Alias for @toMIDI@.-tom = toMIDI+-- tom = toMIDI ++{- | The `fit` function takes a pattern of integer numbers, which are used to select values from the given list. What makes this a bit strange is that only a given number of values are selected each cycle. For example:++@+d1 $ sound (fit 3 ["bd", "sn", "arpy", "arpy:1", "casio"] "0 [~ 1] 2 1")+@++The above fits three samples into the pattern, i.e. for the first cycle this will be `"bd"`, `"sn"` and `"arpy"`, giving the result `"bd [~ sn] arpy sn"` (note that we start counting at zero, so that `0` picks the first value). The following cycle the *next* three values in the list will be picked, i.e. `"arpy:1"`, `"casio"` and `"bd"`, giving the pattern `"arpy:1 [~ casio] bd casio"` (note that the list wraps round here).++-} fit :: Int -> [a] -> Pattern Int -> Pattern a fit perCycle xs p = (xs !!!) <$> (Pattern $ \a -> map ((\e -> (mapThd' (+ (cyclePos perCycle e)) e))) (arc p a)) where cyclePos perCycle e = perCycle * (floor $ eventStart e)@@ -697,7 +991,16 @@ parseLMRule' str = map fixer $ parseLMRule str where fixer (c,r) = (head c, r) --- for example, `lindenmayer 1 "a:b,b:ab" "ab" -> "bab"`+{- | returns the `n`th iteration of a [Lindenmayer System](https://en.wikipedia.org/wiki/L-system) with given start sequence.++for example:++~~~~{haskell}++lindenmayer 1 "a:b,b:ab" "ab" -> "bab"++~~~~+-} lindenmayer :: Int -> String -> String -> String lindenmayer n r [] = [] lindenmayer 1 r (c:cs) = (fromMaybe [c] $ lookup c $ parseLMRule' r) @@ -709,7 +1012,7 @@ unwrap' pp = Pattern $ \a -> arc (stack $ map scalep (arc pp a)) a where scalep ev = compress (fst' ev) $ thd' ev --- removes events from pattern b that don't start during an event from pattern a+-- | removes events from pattern b that don't start during an event from pattern a mask :: Pattern a -> Pattern b -> Pattern b mask pa pb = Pattern $ \a -> concat [filterOns (subArc a $ eventArc i) (arc pb a) | i <- arc pa a] where filterOns Nothing es = []@@ -724,9 +1027,42 @@ (zoom (enclosingArc $ map eventArc $ arc p (sam s,nextSam s)) p) a --- usage example: fit' 2 4 "[0 1 2 3]/2" "[0 3 1 1, 2*4]" "[bd sn:2 cp*2 hh]/2"+{- | `fit'` is a generalization of `fit`, where the list is instead constructed by using another integer pattern to slice up a given pattern. The first argument is the number of cycles of that latter pattern to use when slicing. It's easier to understand this with a few examples:++@+d1 $ sound (fit' 1 2 "0 1" "1 0" "bd sn")+@++So what does this do? The first `1` just tells it to slice up a single cycle of `"bd sn"`. The `2` tells it to select two values each cycle, just like the first argument to `fit`. The next pattern `"0 1"` is the "from" pattern which tells it how to slice, which in this case means `"0"` maps to `"bd"`, and `"1"` maps to `"sn"`. The next pattern `"1 0"` is the "to" pattern, which tells it how to rearrange those slices. So the final result is the pattern `"sn bd"`.++A more useful example might be something like++@+d1 $ fit' 1 4 (run 4) "[0 3*2 2 1 0 3*2 2 [1*8 ~]]/2" $ chop 4 $ (sound "breaks152" # unit "c")+@++which uses `chop` to break a single sample into individual pieces, which `fit'` then puts into a list (using the `run 4` pattern) and reassembles according to the complicated integer pattern.++-} fit' cyc n from to p = unwrap' $ fit n (mapMasks n from' p') to where mapMasks n from p = [stretch $ mask (filterValues (== i) from) p | i <- [0..n-1]] p' = density cyc $ p from' = density cyc $ from++{- `runWith n f p` treats the given pattern `p` as having `n` sections, and applies the function `f` to one of those sections per cycle, running from left to right.++@+d1 $ runWith 4 (density 4) $ sound "cp sn arpy [mt lt]"+@+-}+runWith :: Integral a => a -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b+runWith n f p = do i <- slow (toRational n) $ run (fromIntegral n)+ within (i%(fromIntegral n),(i+)1%(fromIntegral n)) f p+++{- `runWith'` works much the same as `runWith`, but runs from right to left.+ -}+runWith' :: Integral a => a -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b+runWith' n f p = do i <- slow (toRational n) $ rev $ run (fromIntegral n)+ within (i%(fromIntegral n),(i+)1%(fromIntegral n)) f p
− Sound/Tidal/SerialStream.hs
@@ -1,113 +0,0 @@-module Sound.Tidal.SerialStream (- serialDevices,- serialBackend,- blinken,- blinkenStream,- blinkenState,- blinkenSetters,- light) where--import Data.List-import Data.Maybe-import qualified Data.Map.Strict as Map-import qualified Data.ByteString.Char8 as B--import Control.Exception-import Control.Concurrent.MVar-import qualified System.Hardware.Serialport as Serial--import Sound.Tidal.Time-import Sound.Tidal.Stream-import Sound.Tidal.Transition-import Sound.Tidal.Pattern-import Sound.Tidal.Params--type SerialMap = Map.Map Param (Maybe String)-type SerialDeviceMap = Map.Map String Serial.SerialPort--toSerialString :: Value -> Maybe String-toSerialString (VF x) = Just $ show x-toSerialString (VI x) = Just $ show x-toSerialString (VS x) = Just $ x--toSerialMap :: ParamMap -> SerialMap-toSerialMap m = Map.map (toSerialString) (Map.mapMaybe (id) m)--send' s content = do- Serial.send s $ B.pack $ content ++ "\n"- return ()---send s shape change tick (o, m) = msg- where- msg = doAt logicalOnset $ send' s params''- -- get the first value of the first param for now- params'' = case length params' of- 0 -> ""- _ -> head $ params'- params' = catMaybes $ map snd $ Map.toList m- logicalOnset = logicalOnset' change tick o ((latency shape) + nudge)- nudge = maybe 0 (toF) (Map.lookup (F "nudge" (Just 0)) m)- toF (Just s) = read s- toF _ = 0---useOutput outsM name = do- outs <- readMVar outsM- let outM = Map.lookup name outs- case outM of- Just o -> do- putStrLn "Cached Serial Device output"- return $ Just o- Nothing -> do- o <- Serial.openSerial name Serial.defaultSerialSettings { Serial.commSpeed = Serial.CS115200 }- swapMVar outsM $ Map.insert name o outs- return $ Just o--makeConnection :: MVar (SerialDeviceMap) -> String -> IO (ToMessageFunc)-makeConnection devices device = do- moutput <- useOutput devices device- case moutput of- Just s ->- return $ (\ shape change tick (o, m) -> do- m' <- fmap (toSerialMap) (applyShape' shape m)- return $ send s shape change tick (o, m')- )-- Nothing ->- error ("Failed connecting to serial device: '" ++ device ++ "'")---serialDevices :: IO (MVar (SerialDeviceMap))-serialDevices = do- d <- newMVar $ Map.fromList []- return d--serialBackend d n = do- s <- makeConnection d n- return $ Backend s--blinkenStream d n = do- backend <- serialBackend d n- stream backend blinken--blinkenState d n = do- backend <- serialBackend d n- state backend blinken--blinkenSetters :: MVar (SerialDeviceMap) -> String -> IO Time -> IO (ParamPattern -> IO (), (Time -> [ParamPattern] -> ParamPattern) -> ParamPattern -> IO ())-blinkenSetters d n getNow = do- ds <- blinkenState d n- return (setter ds, transition getNow ds)--light :: Pattern String -> ParamPattern-light = make' VS light_p-light_p = S "light" Nothing--blinken = Shape {- params = [- light_p- ],- cpsStamp = True,- latency = 0.01- }
Sound/Tidal/Strategies.hs view
@@ -6,8 +6,9 @@ import Control.Applicative import qualified Data.Map as Map import qualified Data.Char as Char-+import Data.Fixed import Data.Maybe+ import Sound.Tidal.Dirt import Sound.Tidal.Pattern import Sound.Tidal.Stream@@ -23,24 +24,102 @@ quad = stutter 4 double = echo -jux f p = stack [p # pan (pure 0), f $ p # pan (pure 1)]+{- | The `jux` function creates strange stereo effects, by applying a+function to a pattern, but only in the right-hand channel. For+example, the following reverses the pattern on the righthand side:++@+d1 $ slow 32 $ jux (rev) $ striate' 32 (1/16) $ sound "bev"+@++When passing pattern transforms to functions like [jux](#jux) and [every](#every),+it's possible to chain multiple transforms together with `.`, for+example this both reverses and halves the playback speed of the+pattern in the righthand channel:++@+d1 $ slow 32 $ jux ((# speed "0.5") . rev) $ striate' 32 (1/16) $ sound "bev"+@+-}+jux = juxBy 1 juxcut f p = stack [p # pan (pure 0) # cut (pure (-1)), f $ p # pan (pure 1) # cut (pure (-2)) ] +{- | In addition to `jux`, `jux'` allows using a list of pattern transform. resulting patterns from each transformation will be spread via pan from left to right.++For example:++@+d1 $ jux' [iter 4, chop 16, id, rev, palindrome] $ sound "bd sn"+@++will put `iter 4` of the pattern to the far left and `palindrome` to the far right. In the center the original pattern will play and mid left mid right the chopped and the reversed version will appear.++One could also write:++@+d1 $ stack [ + iter 4 $ sound "bd sn" # pan "0", + chop 16 $ sound "bd sn" # pan "0.25", + sound "bd sn" # pan "0.5", + rev $ sound "bd sn" # pan "0.75", + palindrome $ sound "bd sn" # pan "1", + ] +@++-} jux' fs p = stack $ map (\n -> ((fs !! n) p) # pan (pure $ fromIntegral n / fromIntegral l)) [0 .. l-1] where l = length fs --- For multichannel+-- | Multichannel variant of `jux`, _not sure what it does_ jux4 f p = stack [p # pan (pure (5/8)), f $ p # pan (pure (1/8))] -juxBy n f p = stack [p # pan (pure $ 0.5 - (n/2)), f $ p # pan (pure $ 0.5 + (n/2))]+{- |+With `jux`, the original and effected versions of the pattern are+panned hard left and right (i.e., panned at 0 and 1). This can be a+bit much, especially when listening on headphones. The variant `juxBy`+has an additional parameter, which brings the channel closer to the+centre. For example: --- every 4 (smash 4 [1, 2, 3]) $ sound "[odx sn/2 [~ odx] sn/3, [~ hh]*4]"+@+d1 $ juxBy 0.5 (density 2) $ sound "bd sn:1"+@ +In the above, the two versions of the pattern would be panned at 0.25+and 0.75, rather than 0 and 1.+-}+juxBy n f p = stack [p |+| pan (pure $ 0.5 - (n/2)), f $ p |+| pan (pure $ 0.5 + (n/2))]++{- | Smash is a combination of `spread` and `striate` - it cuts the samples+into the given number of bits, and then cuts between playing the loop+at different speeds according to the values in the list.++So this:++@+d1 $ smash 3 [2,3,4] $ sound "ho ho:2 ho:3 hc"+@++Is a bit like this:++@+d1 $ spread (slow) [2,3,4] $ striate 3 $ sound "ho ho:2 ho:3 hc"+@++This is quite dancehall:++@+d1 $ (spread' slow "1%4 2 1 3" $ spread (striate) [2,3,4,1] $ sound+"sn:2 sid:3 cp sid:4")+ # speed "[1 2 1 1]/2"+@+-} smash n xs p = slowcat $ map (\n -> slow n p') xs where p' = striate n p +{- | an altenative form to `smash` is `smash'` which will use `chop` instead of `striate`.+-} smash' n xs p = slowcat $ map (\n -> slow n p') xs where p' = chop n p @@ -73,6 +152,12 @@ --spreadf :: [Pattern a -> Pattern b] -> Pattern a -> Pattern b spreadf ts p = spread ($) +{- | `spin` will "spin" a layer up a pattern the given number of times, with each successive layer offset in time by an additional `1/n` of a cycle, and panned by an additional `1/n`. The result is a pattern that seems to spin around. This function works best on multichannel systems.++@+d1 $ slow 3 $ spin 4 $ sound "drum*3 tabla:4 [arpy:2 ~ arpy] [can:2 can:3]"+@+-} spin :: Int -> ParamPattern -> ParamPattern spin copies p = stack $ map (\n -> let offset = toInteger n % toInteger copies in@@ -105,9 +190,33 @@ inside n f p = density n $ f (slow n p) ++{- | `scale` will take a pattern which goes from 0 to 1 (like `sine1`), and scale it to a different range - between the first and second arguments. In the below example, `scale 1 1.5` shifts the range of `sine1` from 0 - 1 to 1 - 1.5.++@+d1 $ jux (iter 4) $ sound "arpy arpy:2*2"+ |+| speed (slow 4 $ scale 1 1.5 sine1)+@+-} scale :: (Functor f, Num b) => b -> b -> f b -> f b scale from to p = ((+ from) . (* (to-from))) <$> p +{- | `chop` granualizes every sample in place as it is played, turning a pattern of samples into a pattern of sample parts. Use an integer value to specify how many granules each sample is chopped into:++@+d1 $ chop 16 $ sound "arpy arp feel*4 arpy*4"+@++Different values of `chop` can yield very different results, depending+on the samples used:+++@+d1 $ chop 16 $ sound (samples "arpy*8" (run 16))+d1 $ chop 32 $ sound (samples "arpy*8" (run 16))+d1 $ chop 256 $ sound "bd*4 [sn cp] [hh future]*2 [cp feel]"+@+-} chop :: Int -> ParamPattern -> ParamPattern chop n p = Pattern $ \queryA -> concatMap (f queryA) $ arcCycles queryA where f queryA a = concatMap (chopEvent queryA) (arc p a)@@ -115,6 +224,14 @@ newEvent :: ParamMap -> (Int, Arc) -> Event ParamMap newEvent v (i, a) = (a,a,Map.insert (param dirt "end") (Just $ VF ((fromIntegral $ i+1)/(fromIntegral n))) $ Map.insert (param dirt "begin") (Just $ VF ((fromIntegral i)/(fromIntegral n))) v) +{- | `gap` is similar to `chop` in that it granualizes every sample in place as it is played,+but every other grain is silent. Use an integer value to specify how many granules+each sample is chopped into:++@+d1 $ gap 8 $ sound "jvbass"+d1 $ gap 16 $ sound "[jvbass drum:4]"+@-} gap :: Int -> ParamPattern -> ParamPattern gap n p = Pattern $ \queryA -> concatMap (f queryA) $ arcCycles queryA where f queryA a = concatMap (chopEvent queryA) (arc p a)@@ -149,18 +266,46 @@ en :: [(Int, Int)] -> Pattern String -> Pattern String en ns p = stack $ map (\(i, (k, n)) -> e k n (samples p (pure i))) $ enumerate ns +{- |+`weave` applies a function smoothly over an array of different patterns. It uses an `OscPattern` to+apply the function at different levels to each pattern, creating a weaving effect.++@+d1 $ weave 3 (shape $ sine1) [sound "bd [sn drum:2*2] bd*2 [sn drum:1]", sound "arpy*8 ~"]+@+-} weave :: Rational -> ParamPattern -> [ParamPattern] -> ParamPattern weave t p ps = weave' t p (map (\x -> (x #)) ps) ++{- | `weave'` is similar in that it blends functions at the same time at different amounts over a pattern:++@+d1 $ weave' 3 (sound "bd [sn drum:2*2] bd*2 [sn drum:1]") [density 2, (# speed "0.5"), chop 16]+@+-} weave' :: Rational -> Pattern a -> [Pattern a -> Pattern a] -> Pattern a weave' t p fs | l == 0 = silence | otherwise = slow t $ stack $ map (\(i, f) -> (fromIntegral i % l) <~ (density t $ f (slow t p))) (zip [0 ..] fs) where l = fromIntegral $ length fs +{- | +(A function that takes two OscPatterns, and blends them together into+a new OscPattern. An OscPattern is basically a pattern of messages to+a synthesiser.)++Shifts between the two given patterns, using distortion.++Example:++@+d1 $ interlace (sound "bd sn kurt") (every 3 rev $ sound "bd sn:2")+@+-} interlace :: ParamPattern -> ParamPattern -> ParamPattern interlace a b = weave 16 (shape $ ((* 0.9) <$> sinewave1)) [a, b] --- Step sequencing+-- | Step sequencing step :: String -> String -> Pattern String step s steps = cat $ map f steps where f c | c == 'x' = atom s@@ -170,7 +315,7 @@ steps :: [(String, String)] -> Pattern String steps = stack . map (\(a,b) -> step a b) --- like step, but allows you to specify an array of strings to use for 0,1,2...+-- | like `step`, but allows you to specify an array of strings to use for 0,1,2... step' :: [String] -> String -> Pattern String step' ss steps = cat $ map f steps where f c | c == 'x' = atom $ ss!!0@@ -183,6 +328,16 @@ offadd :: Num a => Time -> a -> Pattern a -> Pattern a offadd t n p = off t ((+n) <$>) p +{- | `up` does a poor man's pitchshift by semitones via `speed`.++You can easily produce melodies from a single sample with up:++@+d1 # up "0 5 4 12" # sound "arpy"+@++This will play the _arpy_ sample four times a cycle in the original pitch, pitched by 5 semitones, by 4 and then by an octave.+-} up :: Pattern Double -> ParamPattern up = speed . ((1.059466**) <$>) @@ -198,3 +353,17 @@ randslice :: Int -> ParamPattern -> ParamPattern randslice n p = unwrap $ (\i -> slice i n p) <$> irand n++{- |+`loopAt` makes a sample fit the given number of cycles. Internally, it+works by setting the `unit` parameter to "c", changing the playback+speed of the sample with the `speed` parameter, and setting setting+the `density` of the pattern to match.++@+d1 $ loopAt 4 $ sound "breaks125"+d1 $ juxBy 0.6 (|*| speed "2") $ slowspread (loopAt) [4,6,2,3] $ chop 12 $ sound "fm:14"+@ +-}+loopAt :: Time -> ParamPattern -> ParamPattern+loopAt n p = slow n p |*| speed (pure $ fromRational $ 1/n) # unit (pure "c")
Sound/Tidal/Stream.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings, FlexibleInstances, RankNTypes, NoMonomorphismRestriction #-}+{-# LANGUAGE OverloadedStrings, FlexibleInstances, RankNTypes, NoMonomorphismRestriction, DeriveDataTypeable #-} module Sound.Tidal.Stream where @@ -10,6 +10,7 @@ import Data.Time (getCurrentTime) import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds) import Data.Ratio+import Data.Typeable import Sound.Tidal.Pattern import qualified Sound.Tidal.Parse as P import Sound.Tidal.Tempo (Tempo, logicalTime, clocked,clockedTick,cps)@@ -21,12 +22,14 @@ type ToMessageFunc = Shape -> Tempo -> Int -> (Double, ParamMap) -> Maybe (IO ()) data Backend a = Backend {- toMessage :: ToMessageFunc+ toMessage :: ToMessageFunc,+ flush :: Shape -> Tempo -> Int -> IO () } data Param = S {name :: String, sDefault :: Maybe String} | F {name :: String, fDefault :: Maybe Double} | I {name :: String, iDefault :: Maybe Int}+ deriving Typeable instance Eq Param where a == b = name a == name b@@ -41,12 +44,13 @@ cpsStamp :: Bool} -data Value = VS { svalue :: String } | VF { fvalue :: Double } | VI { ivalue :: Int } deriving (Show,Eq,Ord)+data Value = VS { svalue :: String } | VF { fvalue :: Double } | VI { ivalue :: Int }+ deriving (Show,Eq,Ord,Typeable) type ParamMap = Map.Map Param (Maybe Value) type ParamPattern = Pattern ParamMap-+ ticksPerCycle = 8 defaultValue :: Param -> Maybe Value@@ -134,6 +138,7 @@ (toMessage backend shape change ticks) (seqToRelOnsets (a, b) p) E.catch (sequence_ messages) (\msg -> putStrLn $ "oops " ++ show (msg :: E.SomeException))+ flush backend shape change ticks return () -- Variant where mutable variable contains list as history of the patterns@@ -148,6 +153,7 @@ (toM shape change ticks) (seqToRelOnsets (a, b) $ fst ps) E.catch (sequence_ messages) (\msg -> putStrLn $ "oops " ++ show (msg :: E.SomeException))+ flush backend shape change ticks return () make :: (a -> Value) -> Shape -> String -> Pattern a -> ParamPattern
Sound/Tidal/SuperCollider.hs view
@@ -25,7 +25,7 @@ scBackend n = do s <- makeConnection "127.0.0.1" 57110 (scSlang n)- return $ Backend s+ return $ Backend s (\_ _ _ -> return ()) scStream n ps l = do let shape = (supercollider ps l) backend <- scBackend n
− Sound/Tidal/Synth.hs
@@ -1,18 +0,0 @@-module Sound.Tidal.Synth where--import Sound.Tidal.Params-import Sound.Tidal.MIDI.Control-import Sound.Tidal.MIDI.Params--synthController :: ControllerShape-synthController = ControllerShape {- controls = [- mCC modwheel_p 1,- mCC pan_p 10,- mCC expression_p 11,- mCC sustainpedal_p 64- ],- latency = 0.01- }--synth = toShape synthController
Sound/Tidal/Time.hs view
@@ -1,3 +1,7 @@+{-|+Module: Time+Description: Defines core data types and functions for handling tidal's concept of time in `Arc`s & `Event`s+-} module Sound.Tidal.Time where import Sound.Tidal.Utils@@ -36,7 +40,7 @@ cyclePos :: Time -> Time cyclePos t = t - sam t --- | @isIn a t@ is @True@ iff @t@ is inside +-- | @isIn a t@ is @True@ if @t@ is inside -- the arc represented by @a@. isIn :: Arc -> Time -> Bool isIn (s,e) t = t >= s && t < e@@ -96,14 +100,18 @@ midPoint :: Arc -> Time midPoint (s,e) = s + ((e - s) / 2) +-- | `True` if an `Event`'s first and second `Arc`'s start times match hasOnset :: Event a -> Bool hasOnset ((s,_), (s',_), _) = s == s' +-- | `True` if an `Event`'s first and second `Arc`'s end times match hasOffset :: Event a -> Bool hasOffset ((_,e), (_,e'), _) = e == e' +-- | `True` if an `Event`'s starts is within given `Arc` onsetIn :: Arc -> Event a -> Bool onsetIn a e = isIn a (eventOnset e) +-- | `True` if an `Event`'s ends is within given `Arc` offsetIn :: Arc -> Event a -> Bool offsetIn a e = isIn a (eventOffset e)
Sound/Tidal/Transition.hs view
@@ -22,7 +22,7 @@ putMVar mv (p', (p:snd ps)) return () --- Pans the last n versions of the pattern across the field+-- | Pans the last n versions of the pattern across the field histpan :: Int -> Time -> [ParamPattern] -> ParamPattern histpan _ _ [] = silence histpan 0 _ _ = silence@@ -48,27 +48,38 @@ wash f t now (p:p':_) = overlay (playWhen (< (now + t)) $ f p') (playWhen (>= (now + t)) p) --- Just stop for a bit before playing new pattern+-- | Just stop for a bit before playing new pattern wait :: Time -> Time -> [ParamPattern] -> ParamPattern wait t _ [] = silence wait t now (p:_) = playWhen (>= (nextSam (now+t-1))) p --- transition at cycle boundary after n cycles-jumpIn' :: Int -> Time -> [ParamPattern] -> ParamPattern-jumpIn' n now = superwash id id ((nextSam now) - now + (fromIntegral n)) 0 now+{- |+Jumps directly into the given pattern, this is essentially the _no transition_-transition. --- sharp transition a certain number of cycles in the future+Variants of `jump` provide more useful capabilities, see `jumpIn` and `jumpMod`+-}+jump :: Time -> [ParamPattern] -> ParamPattern+jump = jumpIn 0++{- | Sharp `jump` transition after the specified number of cycles have passed.++@+t1 (jumpIn 2) $ sound "kick(3,8)"+@+-} jumpIn :: Int -> Time -> [ParamPattern] -> ParamPattern jumpIn n = superwash id id (fromIntegral n) 0 -jump :: Time -> [ParamPattern] -> ParamPattern-jump = jumpIn 0+{- | Unlike `jumpIn` the variant `jumpIn'` will only transition at cycle boundary (e.g. when the cycle count is an integer).+-}+jumpIn' :: Int -> Time -> [ParamPattern] -> ParamPattern+jumpIn' n now = superwash id id ((nextSam now) - now + (fromIntegral n)) 0 now --- transition at next cycle boundary where cycle mod n == 0+-- | Sharp `jump` transition at next cycle boundary where cycle mod n == 0 jumpMod :: Int -> Time -> [ParamPattern] -> ParamPattern jumpMod n now = jumpIn ((n-1) - ((floor now) `mod` n)) now --- Degrade the new pattern over time until it goes to nothing+-- | Degrade the new pattern over time until it goes to nothing mortal :: Time -> Time -> Time -> [ParamPattern] -> ParamPattern mortal _ _ _ [] = silence mortal lifespan release now (p:_) = overlay (playWhen (<(now+lifespan)) p) (playWhen (>= (now+lifespan)) (fadeOut' (now + lifespan) release p))
Sound/Tidal/Utils.hs view
@@ -1,24 +1,43 @@+{-|+Module: Utils+Description: Helper functions not directly specific to Tidal+-} module Sound.Tidal.Utils where import System.Environment (getEnv) import Data.Maybe (listToMaybe) import Control.Exception +{- | enumerate a list of things++>>> enumerate ["foo","bar","baz"]+[(1,"foo"), (2,"bar"), (3,"baz")]+-} enumerate :: [a] -> [(Int, a)] enumerate = zip [0..] +-- | apply @f@ to the first element of a tuple mapFst :: (a -> b) -> (a, c) -> (b, c) mapFst f (x,y) = (f x,y) +-- | apply function to the first value of each tuple in given list mapFsts :: (a -> b) -> [(a, c)] -> [(b, c)] mapFsts = map . mapFst +-- | apply @f@ to the second element of a tuple mapSnd :: (a -> b) -> (c, a) -> (c, b) mapSnd f (x,y) = (x,f y) +-- | apply function to the second value of each tuple in given list mapSnds :: (a -> b) -> [(c, a)] -> [(c, b)] mapSnds = fmap . mapSnd ++{- | split given list of @a@ by given single a, e.g.++>>> wordsBy (== ':') "bd:3"+["bd", "3"]+-} wordsBy :: (a -> Bool) -> [a] -> [[a]] wordsBy p s = case dropWhile p s of [] -> []@@ -28,41 +47,61 @@ maybeRead :: String -> Maybe Double maybeRead = fmap fst . listToMaybe . reads +-- | shorthand for first element of triple fst' (a, _, _) = a+-- | shorthand for second element of triple snd' (_, b, _) = b+-- | shorthand for third element of triple thd' (_, _, c) = c -+-- | apply @f@ to the first element of a triple mapFst' :: (a -> x) -> (a, b, c) -> (x, b, c) mapFst' f (x,y,z) = (f x,y,z) +-- | apply @f@ to the second element of a triple mapSnd' :: (b -> x) -> (a, b, c) -> (a, x, c) mapSnd' f (x,y,z) = (x,f y,z) +-- | apply @f@ to the third element of a triple mapThd' :: (c -> x) -> (a, b, c) -> (a, b, x) mapThd' f (x,y,z) = (x,y,f z) +-- | apply function to the second value of each triple in given list mapFsts' :: (a -> x) -> [(a, b, c)] -> [(x, b, c)] mapFsts' = fmap . mapFst' +-- | apply function to the second value of each triple in given list mapSnds' :: (b -> x) -> [(a, b, c)] -> [(a, x, c)] mapSnds' = fmap . mapSnd' +-- | apply function to the third value of each triple in given list mapThds' :: (c -> x) -> [(a, b, c)] -> [(a, b, x)] mapThds' = fmap . mapThd' -mapArcs :: (a -> a) -> [(a, a, x)] -> [(a, a, x)] +-- | map @f@ over a given list of arcs+mapArcs :: (a -> a) -> [(a, a, x)] -> [(a, a, x)] mapArcs f = (mapFsts' f) . (mapSnds' f) +-- | return environment variable @var@'s value or @defValue@ getEnvDefault :: String -> String -> IO String getEnvDefault defValue var = do res <- try . getEnv $ var return $ either (const defValue) id (res :: Either IOException String) +{- | combines two lists by interleaving them++>>> mergelists [1,2,3] [9,8,7]+[1,9,2,8,3,7]+-} mergelists :: [a] -> [a] -> [a] mergelists xs [] = xs mergelists [] ys = ys mergelists (x:xs) (y:ys) = x : y : mergelists xs ys +{- | like `!!` selects @n@th element from xs, but wraps over at the end of @xs@++>>> map ((!!!) [1,3,5]) [0,1,2,3,4,5]+[1,3,5,1,3,5]+-} (!!!) :: [a] -> Int -> a (!!!) xs n = xs !! (n `mod` length xs)
tidal.cabal view
@@ -1,5 +1,5 @@ name: tidal-version: 0.7.1+version: 0.8 synopsis: Pattern language for improvised music -- description: homepage: http://tidal.lurk.org/@@ -23,12 +23,6 @@ Sound.Tidal.Pattern Sound.Tidal.Stream Sound.Tidal.OscStream- Sound.Tidal.MidiStream- Sound.Tidal.MIDI.Device- Sound.Tidal.MIDI.Params- Sound.Tidal.MIDI.Control- Sound.Tidal.Synth- Sound.Tidal.SerialStream Sound.Tidal.Parse Sound.Tidal.Tempo Sound.Tidal.Time@@ -38,4 +32,4 @@ Sound.Tidal.Params Sound.Tidal.Transition - Build-depends: base < 5, process, parsec, hosc > 0.13, hashable, colour, containers, time, websockets > 0.8, text, mtl >=2.1, transformers, mersenne-random-pure64,binary, bytestring, hmt, PortMidi == 0.1.6.0, serialport >= 0.4.7+ Build-depends: base < 5, process, parsec, hosc > 0.13, hashable, colour, containers, time, websockets > 0.8, text, mtl >=2.1, transformers, mersenne-random-pure64,binary, bytestring, hmt
tidal.el view
@@ -57,18 +57,28 @@ (tidal-send-string ":set prompt \"\"") (tidal-send-string ":module Sound.Tidal.Context") (tidal-send-string "(cps, getNow) <- bpsUtils")- (tidal-send-string "(d1,t1) <- dirtSetters getNow")- (tidal-send-string "(d2,t2) <- dirtSetters getNow")- (tidal-send-string "(d3,t3) <- dirtSetters getNow")- (tidal-send-string "(d4,t4) <- dirtSetters getNow")- (tidal-send-string "(d5,t5) <- dirtSetters getNow")- (tidal-send-string "(d6,t6) <- dirtSetters getNow")- (tidal-send-string "(d7,t7) <- dirtSetters getNow")- (tidal-send-string "(d8,t8) <- dirtSetters getNow")- (tidal-send-string "(d9,t9) <- dirtSetters getNow")- (tidal-send-string "(d10,t10) <- dirtSetters getNow")+ (tidal-send-string "(d1,t1) <- superDirtSetters getNow")+ (tidal-send-string "(d2,t2) <- superDirtSetters getNow")+ (tidal-send-string "(d3,t3) <- superDirtSetters getNow")+ (tidal-send-string "(d4,t4) <- superDirtSetters getNow")+ (tidal-send-string "(d5,t5) <- superDirtSetters getNow")+ (tidal-send-string "(d6,t6) <- superDirtSetters getNow")+ (tidal-send-string "(d7,t7) <- superDirtSetters getNow")+ (tidal-send-string "(d8,t8) <- superDirtSetters getNow")+ (tidal-send-string "(d9,t9) <- superDirtSetters getNow")+ (tidal-send-string "(d10,t10) <- superDirtSetters getNow")+ (tidal-send-string "(c1,ct1) <- dirtSetters getNow")+ (tidal-send-string "(c2,ct2) <- dirtSetters getNow")+ (tidal-send-string "(c3,ct3) <- dirtSetters getNow")+ (tidal-send-string "(c4,ct4) <- dirtSetters getNow")+ (tidal-send-string "(c5,ct5) <- dirtSetters getNow")+ (tidal-send-string "(c6,ct6) <- dirtSetters getNow")+ (tidal-send-string "(c7,ct7) <- dirtSetters getNow")+ (tidal-send-string "(c8,ct8) <- dirtSetters getNow")+ (tidal-send-string "(c9,ct9) <- dirtSetters getNow")+ (tidal-send-string "(c10,ct10) <- dirtSetters getNow") (tidal-send-string "let bps x = cps (x/2)")- (tidal-send-string "let hush = mapM_ ($ silence) [d1,d2,d3,d4,d5,d6,d7,d8,d9,d10]")+ (tidal-send-string "let hush = mapM_ ($ silence) [c1,c2,c3,c4,c5,c6,c7,c8,c9,c10,d1,d2,d3,d4,d5,d6,d7,d8,d9,d10]") (tidal-send-string "let solo = (>>) hush") (tidal-send-string ":set prompt \"tidal> \"") )