diff --git a/HACKING.md b/HACKING.md index cc80d2df4..3fd34d4bb 100644 --- a/HACKING.md +++ b/HACKING.md @@ -1,8 +1,22 @@ -In-progress.. +# Community + +The below might help, but to find people to ask questions about +getting started, join the tidal-innards channel on the TOPLAP slack: + http://toplap.org/toplap-on-slack/ + +You can also ask on the mailing list: + http://lurk.org/groups/tidal/ # Quick guide to contributing a change to Tidal -How to.. +The main repository is maintained on github: + https://github.com/tidalcycles/tidalcycles.github.io + +The SuperDirt repository is here: + https://github.com/musikinformatik/SuperDirt + +We'd like to add some instructions for how to interact with these but +no one has done it yet. For now some bullet points as a placeholder: * Make a dev fork * Make and test a change @@ -11,7 +25,7 @@ How to.. # A process for making a release -How to.. +Likewise, we'd like to describe how to.. * Share with others for testing * Tagging release diff --git a/Sound/Tidal/Compositions.hs b/Sound/Tidal/Compositions.hs new file mode 100644 index 000000000..04079884a --- /dev/null +++ b/Sound/Tidal/Compositions.hs @@ -0,0 +1,21 @@ +{-| +Module: Compositions +Description: compose multiple pattern into more complex patterns + +Some functions work with multiple sets of patterns, interlace them or play them successively. +-} +module Sound.Tidal.Compositions (append, + append', + cat, + randcat, + seqP, + slowcat, + stack, + superimpose, + wedge, + interlace, + spin, + weave) where + +import Sound.Tidal.Pattern +import Sound.Tidal.Strategies diff --git a/Sound/Tidal/ConditionalTransformers.hs b/Sound/Tidal/ConditionalTransformers.hs new file mode 100644 index 000000000..463fb788d --- /dev/null +++ b/Sound/Tidal/ConditionalTransformers.hs @@ -0,0 +1,11 @@ +{-| +Module: ConditionalTransformers +Description: conditionally apply other transformations to pattern + +Conditional transformers are functions that apply other transformations under certain cirumstances. These can be based upon the number of cycles, probability or time-range within a pattern.-} +module Sound.Tidal.ConditionalTransformers (every, + foldEvery, + sometimesBy, + whenmod, + within) where +import Sound.Tidal.Pattern diff --git a/Sound/Tidal/Context.hs b/Sound/Tidal/Context.hs index 9076dcd5d..0f6826892 100644 --- a/Sound/Tidal/Context.hs +++ b/Sound/Tidal/Context.hs @@ -15,7 +15,3 @@ import Sound.Tidal.Time as C 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 diff --git a/Sound/Tidal/Dirt.hs b/Sound/Tidal/Dirt.hs index f55b9b53c..67a1493f2 100644 --- a/Sound/Tidal/Dirt.hs +++ b/Sound/Tidal/Dirt.hs @@ -52,7 +52,10 @@ dirt = Shape { params = [ s_p, 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 @@ superDirtSlang = dirtSlang { timestamp = BundleStamp, path = "/play2", namedPara 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 @@ superDirtState port = do 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 @@ visualcallback = do t <- ticker 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 @@ clutchIn t now (p:p':_) = overlay (fadeOut' now t p') (fadeIn' now t p) 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 diff --git a/Sound/Tidal/MIDI/Control.hs b/Sound/Tidal/MIDI/Control.hs deleted file mode 100644 index d82287788..000000000 --- a/Sound/Tidal/MIDI/Control.hs +++ /dev/null @@ -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 diff --git a/Sound/Tidal/MIDI/Device.hs b/Sound/Tidal/MIDI/Device.hs deleted file mode 100644 index 25d2748f7..000000000 --- a/Sound/Tidal/MIDI/Device.hs +++ /dev/null @@ -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 diff --git a/Sound/Tidal/MIDI/Params.hs b/Sound/Tidal/MIDI/Params.hs deleted file mode 100644 index e788ac542..000000000 --- a/Sound/Tidal/MIDI/Params.hs +++ /dev/null @@ -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) diff --git a/Sound/Tidal/MidiStream.hs b/Sound/Tidal/MidiStream.hs deleted file mode 100644 index 6e6f0c386..000000000 --- a/Sound/Tidal/MidiStream.hs +++ /dev/null @@ -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 diff --git a/Sound/Tidal/OscStream.hs b/Sound/Tidal/OscStream.hs index 19e230537..1a049fc52 100644 --- a/Sound/Tidal/OscStream.hs +++ b/Sound/Tidal/OscStream.hs @@ -29,15 +29,17 @@ toOscDatum (VS x) = Just $ string x 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) diff --git a/Sound/Tidal/Params.hs b/Sound/Tidal/Params.hs index dc6dc2695..41bb83a1c 100644 --- a/Sound/Tidal/Params.hs +++ b/Sound/Tidal/Params.hs @@ -4,11 +4,13 @@ import Sound.Tidal.Stream 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 @@ grp params p = (fmap lookupPattern p) 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) - -velocity :: Pattern Double -> ParamPattern -velocity = make' VF velocity_p -velocity_p = F "velocity" (Just 0.5) - -vowel :: Pattern String -> ParamPattern -vowel = make' VS vowel_p -vowel_p = S "vowel" (Just "") - -cutoff :: Pattern Double -> ParamPattern -cutoff = make' VF cutoff_p -cutoff_p = F "cutoff" (Just 0) - -resonance :: Pattern Double -> ParamPattern -resonance = make' VF resonance_p -resonance_p = F "resonance" (Just 0) - -accelerate :: Pattern Double -> ParamPattern -accelerate = make' VF accelerate_p -accelerate_p = F "accelerate" (Just 0) +a pattern of strings representing sound sample names (required). -shape :: Pattern Double -> ParamPattern -shape = make' VF shape_p -shape_p = F "shape" (Just 0) +`sound` is a combination of the `s` and `n` parameters to allow specifying both sample name and sample variation in one: -kriole :: Pattern Int -> ParamPattern -kriole = make' VI kriole_p -kriole_p = I "kriole" (Just 0) +@ +d1 $ sound "bd:2 sn:0" +@ -gain :: Pattern Double -> ParamPattern -gain = make' VF gain_p -gain_p = F "gain" (Just 1) +is essentially the same as: -cut :: Pattern Int -> ParamPattern -cut = make' VI cut_p -cut_p = I "cut" (Just (0)) - -delay :: Pattern Double -> ParamPattern -delay = make' VF delay_p -delay_p = F "delay" (Just (0)) - -delaytime :: Pattern Double -> ParamPattern -delaytime = make' VF delaytime_p -delaytime_p = F "delaytime" (Just (-1)) - -delayfeedback :: Pattern Double -> ParamPattern -delayfeedback = make' VF delayfeedback_p -delayfeedback_p = F "delayfeedback" (Just (-1)) - -crush :: Pattern Double -> ParamPattern -crush = make' VF crush_p -crush_p = F "crush" (Just 0) - -coarse :: Pattern Int -> ParamPattern -coarse = make' VI coarse_p -coarse_p = I "coarse" (Just 0) - -hcutoff :: Pattern Double -> ParamPattern -hcutoff = make' VF hcutoff_p -hcutoff_p = F "hcutoff" (Just 0) - -hresonance :: Pattern Double -> ParamPattern -hresonance = make' VF hresonance_p -hresonance_p = F "hresonance" (Just 0) - -bandf :: Pattern Double -> ParamPattern -bandf = make' VF bandf_p -bandf_p = F "bandf" (Just 0) - -bandq :: Pattern Double -> ParamPattern -bandq = make' VF bandq_p -bandq_p = F "bandq" (Just 0) - -unit :: Pattern String -> ParamPattern -unit = make' VS unit_p -unit_p = S "unit" (Just "rate") - -loop :: Pattern Int -> ParamPattern -loop = make' VI loop_p -loop_p = I "loop" (Just 1) - -channel :: Pattern Int -> ParamPattern -channel = make' VI channel_p -channel_p = I "channel" Nothing - -room :: Pattern Double -> ParamPattern -room = make' VF room_p -room_p = F "room" Nothing - -size :: Pattern Double -> ParamPattern -size = make' VF size_p -size_p = F "size" Nothing - -dry :: Pattern Double -> ParamPattern -dry = make' VF dry_p -dry_p = F "dry" (Just 0) +@ +d1 $ s "bd sn" # n "2 0" +@ +-} +sound :: Pattern String -> ParamPattern +sound = grp [s_p, n_p] -orbit :: Pattern Int -> ParamPattern -orbit = make' VI orbit_p -orbit_p = I "orbit" (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. + +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`: + +@ +cps 0.5 + +d1 $ sound "breaks125*8" # unit "c" # begin "-1" # cut "-1" # coarse "1 2 4 8 16 32 64 128" +@ + +This will play the `breaks125` sample and apply the changing `coarse` parameter over the sample. Compare to: + +@ +d1 $ (chop 8 $ sounds "breaks125") # unit "c" # coarse "1 2 4 8 16 32 64 128" +@ + +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. + +An example would be an open hi-hat followed by a closed one, essentially muting the open. + +@ +d1 $ stack [ + sound "bd", + sound "~ [~ [ho:2 hc/2]]" # cut "1" + ] +@ + +This will mute the open hi-hat every second cycle when the closed one is played. + +Using `cut` with negative values will only cut the same sample. This is useful to cut very long samples + +@ +d1 $ sound "[bev, [ho:3](3,8)]" # cut "-1" +@ + +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: + +@ +d1 $ stack [ + sound "bd bd/4", + sound "hh(5,8)" + ] # nudge "[0 0.04]*4" +@ + +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 "") + +-- MIDI-specific params + +(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) + +-- 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 + +note = n +midinote = n . ((subtract 60) <$>) + +drum = n . (drumN <$>) + +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 diff --git a/Sound/Tidal/Parse.hs b/Sound/Tidal/Parse.hs index 4f9b3d746..53be3a9cf 100644 --- a/Sound/Tidal/Parse.hs +++ b/Sound/Tidal/Parse.hs @@ -33,6 +33,9 @@ instance Parseable Bool where 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 @@ pPart f = do -- part <- parens (pSequence f) <|> pSingle f <|> pPolyIn f <|> pPo part <- pE part part <- pRand part spaces - parts <- pReplicate part + parts <- pStretch part + <|> pReplicate part spaces return $ parts @@ -151,18 +155,28 @@ pBool = do oneOf "t1" 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) - -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, +pInt = do i <- parseIntNote + return $ atom i + +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 @@ midinote = do n <- notenum 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 @@ pE thing = do (n,k,s) <- parens (pair) 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" diff --git a/Sound/Tidal/Pattern.hs b/Sound/Tidal/Pattern.hs index 0b3032430..5d56a5741 100644 --- a/Sound/Tidal/Pattern.hs +++ b/Sound/Tidal/Pattern.hs @@ -33,11 +33,17 @@ data Pattern a = Pattern {arc :: Arc -> [Event a]} 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 @@ slow t = density (1/t) (~>) :: 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 @@ playWhen test (Pattern f) = Pattern $ (filter (\e -> test (eventOnset e))) . f 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' from dur p = spread' (\n p -> 1 <~ degradeBy n p) (from ~> slow dur ((1- 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 @@ ifp test f1 f2 p = splitQueries $ Pattern apply 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 @@ unDegradeBy x p = unMaybe $ (\a f -> toMaybe (f <= x) a) <$> p <*> rand 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 @@ rarely = sometimesBy 0.25 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,9 +704,35 @@ degrade = degradeBy 0.5 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 @@ -498,12 +743,32 @@ superimpose f p = stack [p, f p] 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 :: Arc -> Pattern a -> Pattern a 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 @@ discretise n p = density n $ (atom (id)) <*> p 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' :: String -> [(Char, String)] 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' :: Pattern (Pattern a) -> Pattern a 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 @@ stretch p = splitQueries $ Pattern $ \a@(s,e) -> arc (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 diff --git a/Sound/Tidal/PatternTransformers.hs b/Sound/Tidal/PatternTransformers.hs new file mode 100644 index 000000000..9c4a52fe2 --- /dev/null +++ b/Sound/Tidal/PatternTransformers.hs @@ -0,0 +1,32 @@ +{- | +Module: PatternTransformers +Description: Transform patterns + +Pattern transformers are functions that take a pattern as input and transform it into a new pattern. + +In the following, functions are shown with their Haskell type and a short description of how they work. +-} +module Sound.Tidal.PatternTransformers ((<~), (~>), + brak, + choose, + degrade, + degradeBy, + density, + fit, + fit', + iter, + palindrome, + rev, + slow, + slowspread, + spread, + trunc, + zoom, + jux, + jux', + juxBy, + jux4, + smash) where + +import Sound.Tidal.Strategies +import Sound.Tidal.Pattern diff --git a/Sound/Tidal/SampleTransformers.hs b/Sound/Tidal/SampleTransformers.hs new file mode 100644 index 000000000..de46884fd --- /dev/null +++ b/Sound/Tidal/SampleTransformers.hs @@ -0,0 +1,17 @@ +{-| +Module: SampleTransformers +Description: transform individual samples + +The following functions manipulate each sample within a pattern, some granularize them, others echo. +-} +module Sound.Tidal.SampleTransformers (chop, + gap, + striate, + striate', + striateL, + striateL', + striateO, + stut, + stut') where +import Sound.Tidal.Strategies +import Sound.Tidal.Dirt diff --git a/Sound/Tidal/SerialStream.hs b/Sound/Tidal/SerialStream.hs deleted file mode 100644 index 71721a7ca..000000000 --- a/Sound/Tidal/SerialStream.hs +++ /dev/null @@ -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 - } diff --git a/Sound/Tidal/Strategies.hs b/Sound/Tidal/Strategies.hs index d23d90cc3..e5a0335d0 100644 --- a/Sound/Tidal/Strategies.hs +++ b/Sound/Tidal/Strategies.hs @@ -6,8 +6,9 @@ import Data.Ratio 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 @@ triple = stutter 3 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 @@ scrumple o p p' = p'' -- overlay p (o ~> p'') --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 @@ cross f p p' = Pattern $ \t -> concat [filter flt $ arc p t, 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 @@ chop n p = Pattern $ \queryA -> concatMap (f queryA) $ arcCycles queryA 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 @@ normEv ev@(_, (s,e), _) ev'@(_, (s',e'), _) 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 @@ step s steps = cat $ map f steps 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 @@ off t f p = superimpose (f . (t ~>)) p 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 @@ slice i n p = 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") diff --git a/Sound/Tidal/Stream.hs b/Sound/Tidal/Stream.hs index 7b13ab684..cfacb0daa 100644 --- a/Sound/Tidal/Stream.hs +++ b/Sound/Tidal/Stream.hs @@ -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 Control.Exception as E 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 @@ import qualified Data.Map as Map 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 @@ data Shape = Shape {params :: [Param], 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 @@ onTick backend shape patternM change ticks (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 @@ onTick' backend shape patternsM change ticks (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 diff --git a/Sound/Tidal/SuperCollider.hs b/Sound/Tidal/SuperCollider.hs index d10d5a1ae..004e50d5b 100644 --- a/Sound/Tidal/SuperCollider.hs +++ b/Sound/Tidal/SuperCollider.hs @@ -25,7 +25,7 @@ scSlang n = OscSlang { 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 diff --git a/Sound/Tidal/Synth.hs b/Sound/Tidal/Synth.hs deleted file mode 100644 index 6953cc035..000000000 --- a/Sound/Tidal/Synth.hs +++ /dev/null @@ -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 diff --git a/Sound/Tidal/Time.hs b/Sound/Tidal/Time.hs index 158681b77..ad5a0e008 100644 --- a/Sound/Tidal/Time.hs +++ b/Sound/Tidal/Time.hs @@ -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 @@ nextSam = (1+) . sam 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 @@ eventArc = snd' 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) diff --git a/Sound/Tidal/Transition.hs b/Sound/Tidal/Transition.hs index c840adb5d..5db2e6d85 100644 --- a/Sound/Tidal/Transition.hs +++ b/Sound/Tidal/Transition.hs @@ -22,7 +22,7 @@ transition getNow mv f p = 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 _ _ _ (p:[]) = p 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. + +Variants of `jump` provide more useful capabilities, see `jumpIn` and `jumpMod` +-} +jump :: Time -> [ParamPattern] -> ParamPattern +jump = jumpIn 0 --- sharp transition a certain number of cycles in the future +{- | 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)) diff --git a/Sound/Tidal/Transitions.hs b/Sound/Tidal/Transitions.hs new file mode 100644 index 000000000..faf8d833e --- /dev/null +++ b/Sound/Tidal/Transitions.hs @@ -0,0 +1,44 @@ +{-| +Module: Transitions +Description: progressively move from on to another pattern + +During live coding evaluation of changes will take effect immediately, that is, if you run: + +@ +d1 silence +@ + +Sound from `d1` will mute a soon as possible. + +However, if you want to _schedule_ another pattern for playback, this might not be intended. + +Transitions are functions that describe _how_ one pattern will transform into another. These range from simple behaviours like, jumping right into the new pattern after a while: + +@ +t1 (jumpIn 2) $ sound "bd(3,8)" +@ + +to complex combinations of both the current and the new pattern: + +@ +t1 anticipate $ slow 4 $ sound "bd sn" # delay "0.5" # room "0.3" +@ + +-} +module Sound.Tidal.Transitions ( + jump, + jumpIn, + jumpIn', + jumpMod, + anticipate, + anticipateIn, + clutch, + clutchIn, + histpan, + mortal, + wait, + xfade, + xfadeIn) where + +import Sound.Tidal.Transition +import Sound.Tidal.Dirt diff --git a/Sound/Tidal/Utility.hs b/Sound/Tidal/Utility.hs new file mode 100644 index 000000000..d726533d7 --- /dev/null +++ b/Sound/Tidal/Utility.hs @@ -0,0 +1,9 @@ +module Sound.Tidal.Utility ( + irand, + rand, + run, + scale, + up) where + +import Sound.Tidal.Strategies +import Sound.Tidal.Pattern diff --git a/Sound/Tidal/Utils.hs b/Sound/Tidal/Utils.hs index ce9bafaba..55b7ccb5c 100644 --- a/Sound/Tidal/Utils.hs +++ b/Sound/Tidal/Utils.hs @@ -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 @@ wordsBy p s = case dropWhile p s of 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) diff --git a/tidal.cabal b/tidal.cabal index 040155785..65bb63a96 100644 --- a/tidal.cabal +++ b/tidal.cabal @@ -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 @@ library 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 @@ library 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 diff --git a/tidal.el b/tidal.el index 4fdcd5ec0..71eeae5de 100644 --- a/tidal.el +++ b/tidal.el @@ -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> \"") )