diff --git a/.github/workflows/listener-build-linux.yml b/.github/workflows/listener-build-linux.yml
index 8cd8512d9..f30d8e2f7 100644
--- a/.github/workflows/listener-build-linux.yml
+++ b/.github/workflows/listener-build-linux.yml
@@ -1,6 +1,11 @@
name: build-listener-linux
-
-on: [push, pull_request]
+on:
+ push:
+ paths-ignore:
+ - "**.md"
+ pull_request:
+ paths-ignore:
+ - "**.md"
jobs:
build:
diff --git a/.github/workflows/listener-build-macosx.yml b/.github/workflows/listener-build-macosx.yml
index 7cd4f8eb1..6ef91601b 100644
--- a/.github/workflows/listener-build-macosx.yml
+++ b/.github/workflows/listener-build-macosx.yml
@@ -1,6 +1,11 @@
name: build-listener-macosx
-
-on: [push, pull_request]
+on:
+ push:
+ paths-ignore:
+ - "**.md"
+ pull_request:
+ paths-ignore:
+ - "**.md"
jobs:
build:
diff --git a/.github/workflows/listener-build-windows.yml b/.github/workflows/listener-build-windows.yml
index 6b54908d7..bf2014205 100644
--- a/.github/workflows/listener-build-windows.yml
+++ b/.github/workflows/listener-build-windows.yml
@@ -1,6 +1,11 @@
name: build-listener-windows
-
-on: [push, pull_request]
+on:
+ push:
+ paths-ignore:
+ - "**.md"
+ pull_request:
+ paths-ignore:
+ - "**.md"
jobs:
build:
diff --git a/.github/workflows/nix.yml b/.github/workflows/nix.yml
index e608b9dfb..44f66746f 100644
--- a/.github/workflows/nix.yml
+++ b/.github/workflows/nix.yml
@@ -1,12 +1,13 @@
# A set of CI jobs for checking the Nix flake.
name: "nix"
-
on:
- pull_request:
push:
- branches:
- - master
+ paths-ignore:
+ - "**.md"
+ pull_request:
+ paths-ignore:
+ - "**.md"
jobs:
cancel-previous-runs:
@@ -31,7 +32,7 @@ jobs:
needs: cancel-previous-runs
strategy:
matrix:
- package: [tidal, tidal-link, tidal-listener, tidal-parse]
+ package: [tidal, tidal-link, tidal-parse]
os: [ubuntu-latest, macos-latest]
runs-on: ${{ matrix.os }}
steps:
diff --git a/BootTidal.hs b/BootTidal.hs
index 1157ec015..c2548d2d3 100644
--- a/BootTidal.hs
+++ b/BootTidal.hs
@@ -29,8 +29,8 @@ let only = (hush >>)
resetCycles = streamResetCycles tidal
setCycle = streamSetCycle tidal
setcps = asap . cps
- getcps = streamGetcps tidal
- getnow = streamGetnow tidal
+ getcps = streamGetCPS tidal
+ getnow = streamGetNow tidal
xfade i = transition tidal True (Sound.Tidal.Transition.xfadeIn 4) i
xfadeIn i t = transition tidal True (Sound.Tidal.Transition.xfadeIn t) i
histpan i t = transition tidal True (Sound.Tidal.Transition.histpan t) i
diff --git a/CHANGELOG.md b/CHANGELOG.md
index 3ccce647f..47bcc26d2 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,25 @@
# TidalCycles log of changes
+## 1.9.5 - Sashiko
+
+## What's Changed
+* avoid loading stream module in other modules, so hint wont crash by @polymorphicengine in https://github.com/tidalcycles/Tidal/pull/1019
+* change streamGetnow to factor in the processAhead and also destroy the sessionstate by @polymorphicengine in https://github.com/tidalcycles/Tidal/pull/1025
+* fix minor7sharp9 chord (the 9th wasn't sharp) by @cleary in https://github.com/tidalcycles/Tidal/pull/1036
+* add metatune param, now against 1.9-dev by @ahihi in https://github.com/tidalcycles/Tidal/pull/1046
+* Build fixes for Tidal 1.9 by @mindofmatthew in https://github.com/tidalcycles/Tidal/pull/1052
+* Update link 1.9 dev by @yaxu in https://github.com/tidalcycles/Tidal/pull/1058
+* More build fixes by @mindofmatthew in https://github.com/tidalcycles/Tidal/pull/1062
+* Consolidate site docs into source docs, and some docs editing by @trespaul in https://github.com/tidalcycles/Tidal/pull/1070
+* Fix negative numbers not working for boolean euclids by @geikha in https://github.com/tidalcycles/Tidal/pull/1063
+
+## New Contributors
+* @ahihi made their first contribution in https://github.com/tidalcycles/Tidal/pull/1046
+* @trespaul made their first contribution in https://github.com/tidalcycles/Tidal/pull/1070
+* @geikha made their first contribution in https://github.com/tidalcycles/Tidal/pull/1063
+
+**Full Changelog**: https://github.com/tidalcycles/Tidal/compare/v1.9.4...v1.9.5
+
## 1.9.4 - Stitch
### What's Changed
@@ -17,7 +37,7 @@
**Full Changelog**: https://github.com/tidalcycles/Tidal/compare/v1.9.3...v1.9.4
-### 1.9.3 - Kolam
+## 1.9.3 - Kolam
### What's Changed
* fix for squeezejoin by @yaxu in https://github.com/tidalcycles/Tidal/pull/950
diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md
index 3a6e5ed6b..edc34eaf5 100644
--- a/CONTRIBUTING.md
+++ b/CONTRIBUTING.md
@@ -20,9 +20,7 @@ compiler/interpreter. Some resources for learning Haskell can be found here:
The main repository is maintained on github:
https://github.com/tidalcycles/tidal
-**Please note that ongoing development work towards version 2.0 happens on the 'main'
-branch. At the time of writing, bugfixes for current releases should target
-the '1.9-dev' branch.**
+**At the time of writing, current work should target the '1.10-dev' branch. The 2.0-dev branch is for experiments towards version 2.0.**
The SuperDirt repository is here:
https://github.com/musikinformatik/SuperDirt
@@ -85,11 +83,45 @@ firefox dist/hpc/prof/html/tests/hpc_index.html
To run up your changes locally, install Tidal with `cabal install`. To remove them again and revert to the latest release, run `ghc-pkg unregister tidal-1.0.0` being sure to match up the version numbers. (note that ghc packaging is in a state of flux at the moment - this command might not actually work..)
-# A process for making a release
+# Making a Release
-We haven't documented a clear process for this, but we'd like to
-describe how to..
+*Note: This may be incomplete—before making a release, it's a good idea to reach out to an existing project maintainer to double-check the process.*
-* Share with others for testing
-* Tag a release
-* Distribute via hackage / stackage
+First, you'll need to figure out the new version number. Tidal follows the [Haskell Package Versioning Policy](https://pvp.haskell.org/)—basically, for a given version (e.g. `v1.0.0`), only update the last number if you're releasing a minor, non-breaking change (so a bug fix release might be `v1.0.1`). A major release requires editing the first or second numbers (so a major release that substantially adds or changes functionality might be `v1.1.0`, and a release that rearchitects the fundamentals would be `v2.0.0`). Major releases include those that update dependencies to a new major release. It's also a good idea to do a major release for any bugfixes where performers have started using the "bug" for aesthetics.
+
+## Get Permission
+First, you need to do the following:
+
+* Make sure that you have been given Owner permissions on the tidalcycles GitHub organization or the Tidal repository
+* If you don't have one, [create a user account on Hackage](https://hackage.haskell.org/users/register-request). You'll also need to send an email to the Hackage Trustees mailing list to get upload permissions (the email you receive when you create your account will have details about this process).
+* Make sure that you've been added to the maintainers group for the tidal package on Hackage
+
+## Create a Draft Release in GitHub
+
+* Draft a [new Tidal release](https://github.com/tidalcycles/Tidal/releases)
+* The name of the release will be the human-readable nickname (some traditional form of pattern making or something else that strikes your fancy)
+* For the tag, you can specify the next version in the form `v0.0.0` and GitHub will automatically tag the most recent commit whenever you publish the release
+* The "Generate Release Notes" is an easy way to list all the relevant updates and new contributors. Feel free to edit this further as needed
+* **Save this as a draft for now**
+
+## Update the Repository
+
+Push any final changes to the code, updating the following files:
+* **[tidal.cabal](https://github.com/tidalcycles/Tidal/blob/1.10-dev/tidal.cabal)**: Change the version field
+ * **Outdated Dependencies:** Run `cabal update` then `cabal outdated` to determine whether any of Tidal's dependencies are out of date, then update those as well
+* **[CHANGELOG.md](https://github.com/tidalcycles/Tidal/blob/1.10-dev/CHANGELOG.md)**: Add your new version at the top (you can copy the release notes from your draft GitHub release)
+* **[src/Sound/Tidal/Version.hs](https://github.com/tidalcycles/Tidal/blob/1.10-dev/src/Sound/Tidal/Version.hs)**: Update the version string here too. This is the version that's printed to the console when someone starts Tidal.
+* **If any of the other packages (e.g. tidal-link) have changed**: Update the respective **.cabal** files for these packages, and then update dependency information in **tidal.cabal** as needed.
+
+## Test and Package the Repository
+
+* Run `cabal test` to make sure all the tests pass (see above for details).
+* Run `cabal haddock` and watch for errors to test that Cabal can generate the documentation for the package.
+* Run `cabal check` to check for any errors with the package metadata.
+* Run `cabal sdist` to generate an archive for distribution.
+
+## Upload and Test Releases
+
+* [The Hackage upload page](https://hackage.haskell.org/upload) contains instructions and links for uploading a release archive. **Start by uploading a package candidate because a package release can't be changed!**
+* To distribute a package candidate for testing, find the download link for the `.tar.gz` bundle on the Hackage page for the package candidate. This candidate version can be installed with the following command: `cabal v1-install [url]` (note that at this time, [the v1 install command is necessary for installing a library from a URL](https://github.com/haskell/cabal/issues/8335)).
+* Once everyone is happy with the new version, go ahead and upload the archive as a package release and publish the release on GitHub!
\ No newline at end of file
diff --git a/src/Sound/Tidal/Chords.hs b/src/Sound/Tidal/Chords.hs
index d3c162a30..8131dac48 100644
--- a/src/Sound/Tidal/Chords.hs
+++ b/src/Sound/Tidal/Chords.hs
@@ -22,7 +22,10 @@ import Data.Maybe
import Sound.Tidal.Pattern
--- major chords
+-- * Chord definitions
+
+-- ** Major chords
+
major :: Num a => [a]
major = [0,4,7]
aug :: Num a => [a]
@@ -45,7 +48,9 @@ major13 :: Num a => [a]
major13 = [0,4,7,11,14,21]
add13 :: Num a => [a]
add13 = [0,4,7,21]
--- dominant chords
+
+-- ** Dominant chords
+
dom7 :: Num a => [a]
dom7 = [0,4,7,10]
dom9 :: Num a => [a]
@@ -66,7 +71,9 @@ eleven :: Num a => [a]
eleven = [0,4,7,10,14,17]
thirteen :: Num a => [a]
thirteen = [0,4,7,10,14,17,21]
--- minor chords
+
+-- ** Minor chords
+
minor :: Num a => [a]
minor = [0,3,7]
diminished :: Num a => [a]
@@ -97,7 +104,9 @@ minor13 :: Num a => [a]
minor13 = [0,3,7,10,14,17,21]
minorMajor7 :: Num a => [a]
minorMajor7 = [0,3,7,11]
--- other chords
+
+-- ** Other chords
+
one :: Num a => [a]
one = [0]
five :: Num a => [a]
@@ -112,7 +121,9 @@ sevenSus4 :: Num a => [a]
sevenSus4 = [0,5,7,10]
nineSus4 :: Num a => [a]
nineSus4 = [0,5,7,10,14]
--- questionable chords
+
+-- ** Questionable chords
+
sevenFlat10 :: Num a => [a]
sevenFlat10 = [0,4,7,10,15]
nineSharp5 :: Num a => [a]
@@ -128,6 +139,8 @@ elevenSharp = [0,4,7,10,14,18]
minor11sharp :: Num a => [a]
minor11sharp = [0,3,7,10,14,18]
+-- * Chord functions
+
-- | @chordate cs m n@ selects the @n@th "chord" (a chord is a list of Ints)
-- from a list of chords @cs@ and transposes it by @m@
-- chordate :: Num b => [[b]] -> b -> Int -> [b]
@@ -140,6 +153,22 @@ minor11sharp = [0,3,7,10,14,18]
-- enchord :: Num a => [[a]] -> Pattern a -> Pattern Int -> Pattern a
-- enchord chords pn pc = flatpat $ (chordate chords) <$> pn <*> pc
+{-|
+ The @chordTable@ function outputs a list of all available chords and their
+ corresponding notes. For example, its first entry is @("major",[0,4,7])@ which
+ means that a major triad is formed by the root (0), the major third (4 semitones
+ above the root), and the perfect fifth (7 semitones above the root).
+
+ As the list is big, you can use the function 'chordL'.
+
+ If you know the notes from a chord, but can’t find the name of it, you can use this Haskell code to do a reverse look up into the table:
+
+ > filter (\(_,x)->x==[0,4,7,10]) chordTable
+
+ This will output @[("dom7",[0,4,7,10])]@
+
+ (You’ll need to run @import Sound.Tidal.Chords@ before using this function.)
+-}
chordTable :: Num a => [(String, [a])]
chordTable = [("major", major),
("maj", major),
@@ -273,9 +302,31 @@ chordTable = [("major", major),
("m11s", minor11sharp)
]
+-- | Look up a specific chord: @chordL "minor7"@ returns @(0>1)|[0,3,7,10]@.
chordL :: Num a => Pattern String -> Pattern [a]
chordL p = (\name -> fromMaybe [] $ lookup name chordTable) <$> p
+{-|
+Outputs all the available chords:
+
+@
+major maj M aug plus sharp5 six 6 sixNine six9 sixby9 6by9 major7 maj7
+major9 maj9 add9 major11 maj11 add11 major13 maj13 add13 dom7 dom9 dom11
+dom13 sevenFlat5 7f5 sevenSharp5 7s5 sevenFlat9 7f9 nine eleven 11 thirteen 13
+minor min m diminished dim minorSharp5 msharp5 mS5 minor6 min6 m6 minorSixNine
+minor69 min69 minSixNine m69 mSixNine m6by9 minor7flat5 minor7f5 min7flat5
+min7f5 m7flat5 m7f5 minor7 min7 m7 minor7sharp5 minor7s5 min7sharp5 min7s5
+m7sharp5 m7s5 minor7flat9 minor7f9 min7flat9 min7f9 m7flat9 m7f9 minor7sharp9
+minor7s9 min7sharp9 min7s9 m7sharp9 m7s9 diminished7 dim7 minor9 min9 m9
+minor11 min11 m11 minor13 min13 m13 minorMajor7 minMaj7 mmaj7 one 1 five 5
+sus2 sus4 sevenSus2 7sus2 sevenSus4 7sus4 nineSus4 ninesus4 9sus4 sevenFlat10
+7f10 nineSharp5 9sharp5 9s5 minor9sharp5 minor9s5 min9sharp5 min9s5 m9sharp5
+m9s5 sevenSharp5flat9 7s5f9 minor7sharp5flat9 m7sharp5flat9 elevenSharp 11s
+minor11sharp m11sharp m11s
+@
+
+(You’ll need to run @import Sound.Tidal.Chords@ before using this function.)
+-}
chordList :: String
chordList = unwords $ map fst (chordTable :: [(String, [Int])])
@@ -317,6 +368,7 @@ chordToPatSeq f noteP nameP modsP = uncollect $ do
let ch = map (+ n) (fromMaybe [0] $ lookup name chordTable)
applyModifierPatSeq f (return ch) modsP
--- | turns a given pattern of some Num type, a pattern of chord names and a list of patterns of modifiers into a chord pattern
+-- | Turns a given pattern of some 'Num' type, a pattern of chord names, and a
+-- list of patterns of modifiers into a chord pattern
chord :: (Num a, Enum a) => Pattern a -> Pattern String -> [Pattern [Modifier]] -> Pattern a
chord = chordToPatSeq id
diff --git a/src/Sound/Tidal/Context.hs b/src/Sound/Tidal/Context.hs
index 3d78630f5..057f76061 100644
--- a/src/Sound/Tidal/Context.hs
+++ b/src/Sound/Tidal/Context.hs
@@ -22,7 +22,7 @@ import Prelude hiding ((<*), (*>))
import Data.Ratio as C
-import Sound.Tidal.Config as C
+import Sound.Tidal.Stream as C
import Sound.Tidal.Control as C
import Sound.Tidal.Core as C
import Sound.Tidal.Params as C
@@ -31,7 +31,6 @@ import Sound.Tidal.Pattern as C
import Sound.Tidal.Scales as C
import Sound.Tidal.Show as C
import Sound.Tidal.Simple as C
-import Sound.Tidal.Stream as C
import Sound.Tidal.Transition as C
import Sound.Tidal.UI as C
import Sound.Tidal.Version as C
diff --git a/src/Sound/Tidal/Control.hs b/src/Sound/Tidal/Control.hs
index 578051799..434b87159 100644
--- a/src/Sound/Tidal/Control.hs
+++ b/src/Sound/Tidal/Control.hs
@@ -29,20 +29,19 @@ import Data.Ratio
import Sound.Tidal.Pattern
import Sound.Tidal.Core
-import Sound.Tidal.StreamTypes (patternTimeID)
+import Sound.Tidal.Stream.Types (patternTimeID)
import Sound.Tidal.UI
import qualified Sound.Tidal.Params as P
import Sound.Tidal.Utils
-{- | `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.
+{- | `spin` will "spin" and 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 work well on multichannel systems.
-@
-d1 $ slow 3 $ spin 4 $ sound "drum*3 tabla:4 [arpy:2 ~ arpy] [can:2 can:3]"
-@
+> d1 $ slow 3
+> $ spin 4
+> $ sound "drum*3 tabla:4 [arpy:2 ~ arpy] [can:2 can:3]"
-}
spin :: Pattern Int -> ControlPattern -> ControlPattern
spin = tParam _spin
@@ -57,23 +56,36 @@ _spin copies 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:
+{- | `chop` granularises every sample in place as it is played, turning a
+ pattern of samples into a pattern of sample parts. Can be used to explore
+ granular synthesis.
-@
-d1 $ chop 16 $ sound "arpy arp feel*4 arpy*4"
-@
+ Use an integer value to specify how many granules each sample is chopped into:
-Different values of `chop` can yield very different results, depending
-on the samples used:
+ > 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]"
-@
--}
+ > 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]"
+
+ You can also use @chop@ (or 'striate') with very long samples to cut them into short
+ chunks and pattern those chunks. The following cuts a sample into 32 parts, and
+ plays it over 8 cycles:
+
+ > d1 $ loopAt 8 $ chop 32 $ sound "bev"
+
+ The 'loopAt' takes care of changing the speed of sample playback so that the
+ sample fits in the given number of cycles perfectly. As a result, in the above
+ the granules line up perfectly, so you can’t really hear that the sample has
+ been cut into bits. Again, this becomes more apparent when you do further
+ manipulations of the pattern, for example 'rev' to reverse the order of the cut
+ up bits:
+ > d1 $ loopAt 8 $ rev $ chop 32 $ sound "bev"
+-}
chop :: Pattern Int -> ControlPattern -> ControlPattern
chop = tParam _chop
@@ -118,28 +130,25 @@ _chop' n p = begin (fromList begins) # end (fromList ends) # p
-}
-{- | Striate is a kind of granulator, for example:
+{-| Striate is a kind of granulator, cutting samples into bits in a similar to
+chop, but the resulting bits are organised differently. For example:
-@
-d1 $ striate 3 $ sound "ho ho:2 ho:3 hc"
-@
+> 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.
+This plays the loop the given number of times, but triggers 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, and lastly playing the last third of each sample.
+Replacing @striate@ with 'chop' above, one can hear that the ''chop' version
+plays the bits from each chopped-up sample in turn, while @striate@ "interlaces"
+the cut up bits of samples together.
-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.
+You can also use @striate@ with very long samples, to cut them 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"
-@
+> d1 $ slow 8 $ striate 128 $ sound "bev"
-}
striate :: Pattern Int -> ControlPattern -> ControlPattern
@@ -157,20 +166,19 @@ mergePlayRange (b,e) cm = Map.insert "begin" (VF ((b*d')+b')) $ Map.insert "end"
{-|
-The `striateBy` function is a variant of `striate` with an extra
-parameter, which specifies the length of each part. The `striateBy`
+The @striateBy@ function is a variant of `striate` with an extra
+parameter which specifies the length of each part. The @striateBy@
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
+example the following will cut the @bev@ sample into 32 parts, but each
will be 1/16th of a sample long:
-@
-d1 $ slow 32 $ striateBy 32 (1/16) $ sound "bev"
-@
+> d1 $ slow 32 $ striateBy 32 (1/16) $ sound "bev"
-Note that `striate` uses the `begin` and `end` parameters
-internally. This means that if you're using `striate` (or `striateBy`)
-you probably shouldn't also specify `begin` or `end`. -}
+Note that `striate` and @striateBy@ use the `begin` and `end` parameters
+internally. This means that you probably shouldn't also specify `begin` or
+`end`.
+-}
striateBy :: Pattern Int -> Pattern Double -> ControlPattern -> ControlPattern
striateBy = tParam2 _striateBy
@@ -188,10 +196,9 @@ _striateBy n f p = fastcat $ map (offset . fromIntegral) [0 .. n-1]
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]"
-@-}
+> d1 $ gap 8 $ sound "jvbass"
+> d1 $ gap 16 $ sound "[jvbass drum:4]"
+-}
gap :: Pattern Int -> ControlPattern -> ControlPattern
gap = tParam _gap
@@ -200,28 +207,56 @@ _gap :: Int -> ControlPattern -> ControlPattern
_gap n p = _fast (toRational n) (cat [pure 1, silence]) |>| _chop n p
{- |
-`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@ applies one control pattern to a list of other control patterns, with
+ a successive time offset. It uses an `OscPattern` to apply the function at
+ different levels to each pattern, creating a weaving effect. For example:
+
+ > d1 $ weave 16 (pan sine)
+ > [ sound "bd sn cp"
+ > , sound "casio casio:1"
+ > , sound "[jvbass*2 jvbass:2]/2"
+ > , sound "hc*4"
+ > ]
+
+ In the above, the @pan sine@ control pattern is slowed down by the given
+ number of cycles, in particular 16, and applied to all of the given sound
+ patterns. What makes this interesting is that the @pan@ control pattern is
+ successively offset for each of the given sound patterns; because the @pan@ is
+ closed down by 16 cycles, and there are four patterns, they are ‘spread out’,
+ i.e. with a gap of four cycles. For this reason, the four patterns seem to
+ chase after each other around the stereo field. Try listening on headphones to
+ hear this more clearly.
+
+ You can even have it the other way round, and have the effect parameters chasing
+ after each other around a sound parameter, like this:
+
+ > d1 $ weave 16 (sound "arpy" >| n (run 8))
+ > [ vowel "a e i"
+ > , vowel "i [i o] o u"
+ > , vowel "[e o]/3 [i o u]/2"
+ > , speed "1 2 3"
+ > ]
-}
weave :: Time -> ControlPattern -> [ControlPattern] -> ControlPattern
weave t p ps = weave' t p (map (#) ps)
-{- | `weaveWith` is similar in that it blends functions at the same time at different amounts over a pattern:
-
-@
-d1 $ weaveWith 3 (sound "bd [sn drum:2*2] bd*2 [sn drum:1]") [density 2, (# speed "0.5"), chop 16]
-@
+{-|
+ @weaveWith@ is similar to the above, but weaves with a list of functions, rather
+ than a list of controls. For example:
+
+ > d1 $ weaveWith 3 (sound "bd [sn drum:2*2] bd*2 [sn drum:1]")
+ > [ fast 2
+ > , (# speed "0.5")
+ > , chop 16
+ > ]
-}
weaveWith :: Time -> Pattern a -> [Pattern a -> Pattern a] -> Pattern a
weaveWith t p fs | l == 0 = silence
| otherwise = _slow t $ stack $ zipWith (\ i f -> (fromIntegral i % l) `rotL` _fast t (f (_slow t p))) [0 :: Int ..] fs
where l = fromIntegral $ length fs
+-- | An old alias for 'weaveWith'.
weave' :: Time -> Pattern a -> [Pattern a -> Pattern a] -> Pattern a
weave' = weaveWith
@@ -234,9 +269,7 @@ Shifts between the two given patterns, using distortion.
Example:
-@
-d1 $ interlace (sound "bd sn kurt") (every 3 rev $ sound "bd sn:2")
-@
+> d1 $ interlace (sound "bd sn kurt") (every 3 rev $ sound "bd sn:2")
-}
interlace :: ControlPattern -> ControlPattern -> ControlPattern
interlace a b = weave 16 (P.shape (sine * 0.9)) [a, b]
@@ -245,9 +278,7 @@ interlace a b = weave 16 (P.shape (sine * 0.9)) [a, b]
{- | Just like `striate`, but also loops each sample chunk a number of times specified in the second argument.
The primed version is just like `striateBy`, where the loop count is the third argument. For example:
-@
-d1 $ striateL' 3 0.125 4 $ sound "feel sn:2"
-@
+> 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.
-}
@@ -267,6 +298,21 @@ en ns p = stack $ map (\(i, (k, n)) -> _e k n (samples p (pure i))) $ enumerate
-}
+{-| @slice@ is similar to 'chop' and 'striate', in that it’s used to slice
+ samples up into bits. The difference is that it allows you to rearrange those
+ bits as a pattern.
+
+ > d1 $ slice 8 "7 6 5 4 3 2 1 0"
+ > $ sound "breaks165"
+ > # legato 1
+
+ The above slices the sample into eight bits, and then plays them backwards,
+ equivalent of applying rev $ chop 8. Here’s a more complex example:
+
+ > d1 $ slice 8 "[<0*8 0*2> 3*4 2 4] [4 .. 7]"
+ > $ sound "breaks165"
+ > # legato 1
+-}
slice :: Pattern Int -> Pattern Int -> ControlPattern -> ControlPattern
slice pN pI p = P.begin b # P.end e # p
where b = div' <$> pI <* pN
@@ -279,6 +325,16 @@ _slice n i p =
# P.begin (pure $ fromIntegral i / fromIntegral n)
# P.end (pure $ fromIntegral (i+1) / fromIntegral n)
+{-|
+ @randslice@ chops the sample into the given number of pieces and then plays back
+ a random one each cycle:
+
+ > d1 $ randslice 32 $ sound "bev"
+
+ Use 'fast' to get more than one per cycle:
+
+ > d1 $ fast 4 $ randslice 32 $ sound "bev"
+-}
randslice :: Pattern Int -> ControlPattern -> ControlPattern
randslice = tParam $ \n p -> innerJoin $ (\i -> _slice n i p) <$> _irand n
@@ -290,56 +346,80 @@ _splice bits ipat pat = withEvent f (slice (pure bits) ipat pat) # P.unit (pure
where d = sz / fromRational (wholeStop ev - wholeStart ev)
sz = 1/fromIntegral bits
+{-|
+ @splice@ is similar to 'slice', but the slices are automatically pitched up or down
+ to fit their ‘slot’.
+
+ > d1 $ splice 8 "[<0*8 0*2> 3*4 2 4] [4 .. 7]" $ sound "breaks165"
+-}
splice :: Pattern Int -> Pattern Int -> ControlPattern -> Pattern (Map.Map String Value)
splice bitpat ipat pat = innerJoin $ (\bits -> _splice bits ipat pat) <$> bitpat
-{- |
-`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@ 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"
+
+ It’s a good idea to use this in conjuction with 'chop', so the break is chopped
+ into pieces and you don’t have to wait for the whole sample to start/stop.
+
+ > d1 $ loopAt 4 $ chop 32 $ sound "breaks125"
+
+ Like all Tidal functions, you can mess about with this considerably. The below
+ example shows how you can supply a pattern of cycle counts to @loopAt@:
+
+ > d1 $ juxBy 0.6 (|* speed "2")
+ > $ slowspread (loopAt) [4,6,2,3]
+ > $ chop 12
+ > $ sound "fm:14"
-}
loopAt :: Pattern Time -> ControlPattern -> ControlPattern
loopAt n p = slow n p |* P.speed (fromRational <$> (1/n)) # P.unit (pure "c")
+{-|
+ @hurry@ is similiar to 'fast' in that it speeds up a pattern, but it also
+ increases the speed control by the same factor. So, if you’re triggering
+ samples, the sound gets higher in pitch. For example:
+
+ > d1 $ every 2 (hurry 2) $ sound "bd sn:2 ~ cp"
+-}
hurry :: Pattern Rational -> ControlPattern -> ControlPattern
hurry !x = (|* P.speed (fromRational <$> x)) . fast x
-{- | Smash is a combination of `spread` and `striate` - it cuts the samples
+{- | @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:
+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"
-@
+> d1 $ smash 3 [2,3,4] $ sound "ho ho:2 ho:3 hc"
-Is a bit like this:
+is a bit like this:
-@
-d1 $ spread (slow) [2,3,4] $ striate 3 $ sound "ho ho:2 ho:3 hc"
-@
+> 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"
-@
+> 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 :: Pattern Int -> [Pattern Time] -> ControlPattern -> Pattern ValueMap
smash n xs p = slowcat $ map (`slow` p') xs
where p' = striate n p
-{- | an altenative form to `smash` is `smash'` which will use `chop` instead of `striate`.
+{- | An altenative form of `smash`, which uses `chop` instead of `striate`.
+
+ Compare the following variations:
+
+ > d1 $ smash 6 [2,3,4] $ sound "ho ho:2 ho:3 hc"
+ > d1 $ smash' 6 [2,3,4] $ sound "ho ho:2 ho:3 hc"
+ > d1 $ smash 12 [2,3,4] $ s "bev*4"
+ > d1 $ smash' 12 [2,3,4] $ s "bev*4"
-}
smash' :: Int -> [Pattern Time] -> ControlPattern -> ControlPattern
smash' n xs p = slowcat $ map (`slow` p') xs
@@ -347,19 +427,18 @@ smash' n xs p = slowcat $ map (`slow` p') xs
{- |
Applies a type of delay to a pattern.
- It has three parameters, which could be called depth, time and feedback.
+ It has three parameters, which could be called @depth@, @time@ and @feedback@.
+ @depth@ is and integer, and @time@ and @feedback@ are floating point numbers.
This adds a bit of echo:
- @
- d1 $ echo 4 0.2 0.5 $ sound "bd sn"
- @
+
+ > d1 $ echo 4 0.2 0.5 $ 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 $ echo 4 (-0.2) 0.5 $ sound "bd sn"
- @
+
+ > d1 $ echo 4 (-0.2) 0.5 $ sound "bd sn"
-}
echo :: Pattern Integer -> Pattern Rational -> Pattern Double -> ControlPattern -> ControlPattern
echo = tParam3 _echo
@@ -368,13 +447,19 @@ _echo :: Integer -> Rational -> Double -> ControlPattern -> ControlPattern
_echo count time feedback p = _echoWith count time (|* P.gain (pure $ feedback)) p
{- |
- Allows to apply a function for each step and overlays the result delayed by the given time.
+ @echoWith@ is similar to 'echo', but instead of just decreasing volume to
+ produce echoes, @echoWith@ applies a function each step and overlays the
+ result delayed by the given time.
+
+ > d1 $ echoWith 2 "1%3" (# vowel "{a e i o u}%2") $ sound "bd sn"
+
+ In this case there are two _overlays_ delayed by 1/3 of a cycle, where each
+ has the 'vowel' filter applied.
- @
- d1 $ echoWith 2 "1%3" (# vowel "{a e i o u}%2") $ sound "bd sn"
- @
+ > d1 $ echoWith 4 (1/6) (|* speed "1.5") $ sound "arpy arpy:2"
- In this case there are two _overlays_ delayed by 1/3 of a cycle, where each has the @vowel@ filter applied.
+ In the above, three versions are put on top, with each step getting higher in
+ pitch as @|* speed "1.5"@ is successively applied.
-}
echoWith :: Pattern Int -> Pattern Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
echoWith n t f p = innerJoin $ (\a b -> _echoWith a b f p) <$> n <* t
@@ -423,21 +508,22 @@ trigger = triggerWith id
-- with the next cycle boundary. For example, this pattern will fade in
-- starting with the next cycle after the pattern is evaluated:
--
--- @
--- d1 $ qtrigger $ s "hh(5, 8)" # amp envL
--- @
+-- > d1 $ qtrigger $ s "hh(5, 8)" # amp envL
--
-- Note that the pattern will start playing immediately. The /start/ of the
-- pattern aligns with the next cycle boundary, but events will play before
-- if the pattern has events at negative timestamps (which most loops do).
-- These events can be filtered out, for example:
--
--- @
--- d1 $ qtrigger $ filterWhen (>= 0) $ s "hh(5, 8)"
--- @
+-- > d1 $ qtrigger $ filterWhen (>= 0) $ s "hh(5, 8)"
+--
+-- Alternatively, you can use 'wait' to achieve the same result:
+--
+-- > wait 1 1 $ s "bd hh hh hh"
qtrigger :: Pattern a -> Pattern a
qtrigger = ctrigger
+-- | Alias for 'qtrigger'.
qt :: Pattern a -> Pattern a
qt = qtrigger
@@ -456,20 +542,49 @@ rtrigger = triggerWith $ (fromIntegral :: Int -> Rational) . round
ftrigger :: Pattern a -> Pattern a
ftrigger = triggerWith $ (fromIntegral :: Int -> Rational) . floor
--- | (Alias @__mt__@) Mod trigger. Aligns the start of a pattern to the
--- next cycle boundary where the cycle is evenly divisible by a given
--- number. 'qtrigger' is equivalent to @mtrigger 1@.
+{- | (Alias @__mt__@) Mod trigger. Aligns the start of a pattern to the
+ next cycle boundary where the cycle is evenly divisible by a given
+ number. 'qtrigger' is equivalent to @mtrigger 1@.
+
+ In the following example, when activating the @d1@ pattern, it will start at the
+ same time as the next clap, even if it has to wait for 3 cycles. Once activated,
+ the @arpy@ sound will play on every cycle, just like any other pattern:
+
+ > do
+ > resetCycles
+ > d2 $ every 4 (# s "clap") $ s "bd"
+
+ > d1 $ mtrigger 4 $ filterWhen (>=0) $ s "arpy"
+-}
mtrigger :: Int -> Pattern a -> Pattern a
mtrigger n = triggerWith $ fromIntegral . nextMod
where nextMod t = n * ceiling (t / (fromIntegral n))
+-- | Alias for 'mtrigger'.
mt :: Int -> Pattern a -> Pattern a
mt = mtrigger
--- | This aligns the start of a pattern to some value relative to the
--- time the pattern is evaluated. The provided function maps the evaluation
--- time (on the global cycle clock) to a new time, and then @triggerWith@
--- aligns the pattern's start to the time that's returned.
+{- | This aligns the start of a pattern to some value relative to the
+ time the pattern is evaluated. The provided function maps the evaluation
+ time (on the global cycle clock) to a new time, and then @triggerWith@
+ aligns the pattern's start to the time that's returned.
+
+ This is a more flexible triggering function. In fact, all the other trigger
+ functions are defined based on @triggerWith@. For example, 'trigger' is just
+ @triggerWith id@.
+
+ In the next example, use @d1@ as a metronome, and play with different values
+ (from 0 to 1) on the @const@ expression. You’ll notice how the @clap@ is
+ displaced from the beginning of each cycle to the end, as the number increases:
+
+ > d1 $ s "bd hh!3"
+ >
+ > d2 $ triggerWith (const 0.1) $ s "clap"
+
+ This last example is equivalent to this:
+
+ > d2 $ rotR 0.1 $ s "clap"
+-}
triggerWith :: (Time -> Time) -> Pattern a -> Pattern a
triggerWith f pat = pat {query = q}
where q st = query (rotR (offset st) pat) st
diff --git a/src/Sound/Tidal/Core.hs b/src/Sound/Tidal/Core.hs
index ae0b41991..d4b4c8017 100644
--- a/src/Sound/Tidal/Core.hs
+++ b/src/Sound/Tidal/Core.hs
@@ -29,7 +29,13 @@ import Sound.Tidal.Pattern
-- ** Elemental patterns
--- | Takes a function from time to values, and turns it into a 'Pattern'.
+{-| Takes a function of time to values, and turns it into a 'Pattern'.
+ Useful for creating continuous patterns such as 'sine' or 'perlin'.
+
+ For example, 'saw' is defined as
+
+ > saw = sig $ \t -> mod' (fromRational t) 1
+-}
sig :: (Time -> a) -> Pattern a
sig f = Pattern q
where q (State (Arc s e) _)
@@ -50,13 +56,13 @@ sine2 = sig $ \t -> sin_rat ((pi :: Double) * 2 * fromRational t)
-- | @cosine@ - unipolar cosine wave. A pattern of continuous values
-- following a cosine with frequency of one cycle, and amplitude from
--- 0 to 1. Equivalent to `0.25 ~> sine`.
+-- 0 to 1. Equivalent to @0.25 ~> sine@.
cosine :: Fractional a => Pattern a
cosine = 0.25 `rotR` sine
-- | @cosine2@ - bipolar cosine wave. A pattern of continuous values
-- following a cosine with frequency of one cycle, and amplitude from
--- -1 to 1. Equivalent to `0.25 ~> sine2`.
+-- -1 to 1. Equivalent to @0.25 ~> sine2@.
cosine2 :: Fractional a => Pattern a
cosine2 = 0.25 `rotR` sine2
@@ -230,11 +236,21 @@ a ||< b = union <$> a <<* b
-- ** Constructing patterns
--- | Turns a list of values into a pattern, playing one of them per cycle.
+{-| Turns a list of values into a pattern, playing one of them per cycle.
+ The following are equivalent:
+
+ > d1 $ n (fromList [0, 1, 2]) # s "superpiano"
+ > d1 $ n "<0 1 2>" # s "superpiano"
+-}
fromList :: [a] -> Pattern a
fromList = cat . map pure
--- | Turns a list of values into a pattern, playing all of them per cycle.
+{-| Turns a list of values into a pattern, playing /all/ of them per cycle.
+ The following are equivalent:
+
+ > d1 $ n (fastFromList [0, 1, 2]) # s "superpiano"
+ > d1 $ n "[0 1 2]" # s "superpiano"
+-}
fastFromList :: [a] -> Pattern a
fastFromList = fastcat . map pure
@@ -245,19 +261,32 @@ listToPat = fastFromList
-- | 'fromMaybes; is similar to 'fromList', but allows values to
-- be optional using the 'Maybe' type, so that 'Nothing' results in
-- gaps in the pattern.
+-- The following are equivalent:
+-- > d1 $ n (fromMaybes [Just 0, Nothing, Just 2]) # s "superpiano"
+-- > d1 $ n "0 ~ 2" # s "superpiano"
fromMaybes :: [Maybe a] -> Pattern a
fromMaybes = fastcat . map f
where f Nothing = silence
f (Just x) = pure x
--- | A pattern of whole numbers from 0 to the given number, in a single cycle.
+{-| A pattern of whole numbers from 0 to the given number, in a single cycle.
+ Can be used used to @run@ through a folder of samples in order:
+
+ > d1 $ n (run 8) # sound "amencutup"
+
+ The first parameter to run can be given as a pattern:
+
+ > d1 $ n (run "<4 8 4 6>") # sound "amencutup"
+-}
run :: (Enum a, Num a) => Pattern a -> Pattern a
run = (>>= _run)
_run :: (Enum a, Num a) => a -> Pattern a
_run n = fastFromList [0 .. n-1]
--- | From @1@ for the first cycle, successively adds a number until it gets up to @n@
+-- | Similar to 'run', but starts from @1@ for the first cycle, successively
+-- adds a number until it gets up to @n@.
+-- > d1 $ n (scan 8) # sound "amencutup"
scan :: (Enum a, Num a) => Pattern a -> Pattern a
scan = (>>= _scan)
@@ -267,11 +296,20 @@ _scan n = slowcat $ map _run [1 .. n]
-- ** Combining patterns
-- | Alternate between cycles of the two given patterns
+-- > d1 $ append (sound "bd*2 sn") (sound "arpy jvbass*2")
append :: Pattern a -> Pattern a -> Pattern a
append a b = cat [a,b]
--- | Like 'append', but for a list of patterns. Interlaces them, playing the first cycle from each
--- in turn, then the second cycle from each, and so on.
+{- |
+ Like 'append', but for a list of patterns. Interlaces them, playing the
+ first cycle from each in turn, then the second cycle from each, and so on. It
+ concatenates a list of patterns into a new pattern; each pattern in the list
+ will maintain its original duration. For example:
+
+ > d1 $ cat [sound "bd*2 sn", sound "arpy jvbass*2"]
+ > d1 $ cat [sound "bd*2 sn", sound "arpy jvbass*2", sound "drum*2"]
+ > d1 $ cat [sound "bd*2 sn", sound "jvbass*3", sound "drum*2", sound "ht mt"]
+-}
cat :: [Pattern a] -> Pattern a
cat [] = silence
cat ps = Pattern q
@@ -296,14 +334,20 @@ slowappend :: Pattern a -> Pattern a -> Pattern a
slowappend = append
-- | Like 'append', but twice as fast
+-- > d1 $ fastAppend (sound "bd*2 sn") (sound "arpy jvbass*2")
fastAppend :: Pattern a -> Pattern a -> Pattern a
fastAppend a b = _fast 2 $ append a b
fastappend :: Pattern a -> Pattern a -> Pattern a
fastappend = fastAppend
--- | The same as 'cat', but speeds up the result by the number of
--- patterns there are, so the cycles from each are squashed to fit a
--- single cycle.
+{-| The same as 'cat', but speeds up the result by the number of
+ patterns there are, so the cycles from each are squashed to fit a
+ single cycle.
+
+ > d1 $ fastcat [sound "bd*2 sn", sound "arpy jvbass*2"]
+ > d1 $ fastcat [sound "bd*2 sn", sound "arpy jvbass*2", sound "drum*2"]
+ > d1 $ fastcat [sound "bd*2 sn", sound "jvbass*3", sound "drum*2", sound "ht mt"]
+-}
fastCat :: [Pattern a] -> Pattern a
fastCat ps = _fast (toTime $ length ps) $ cat ps
@@ -311,7 +355,21 @@ fastCat ps = _fast (toTime $ length ps) $ cat ps
fastcat :: [Pattern a] -> Pattern a
fastcat = fastCat
--- | Similar to @fastCat@, but each pattern is given a relative duration
+{- | Similar to @fastCat@, but each pattern is given a relative duration.
+ You provide proportionate sizes of the patterns to each other for when they’re
+ concatenated into one cycle. The larger the value in the list, the larger
+ relative size the pattern takes in the final loop. If all values are equal
+ then this is equivalent to fastcat (e.g. the following two code fragments are
+ equivalent).
+
+ > d1 $ fastcat [s "bd*4", s "hh27*8", s "superpiano" # n 0]
+
+ > d1 $ timeCat [ (1, s "bd*4")
+ > , (1, s "hh27*8")
+ > , (1, s "superpiano" # n 0)
+ > ]
+
+-}
timeCat :: [(Time, Pattern a)] -> Pattern a
timeCat tps = stack $ map (\(s,e,p) -> compressArc (Arc (s/total) (e/total)) p) $ arrange 0 tps
where total = sum $ map fst tps
@@ -323,13 +381,42 @@ timeCat tps = stack $ map (\(s,e,p) -> compressArc (Arc (s/total) (e/total)) p)
timecat :: [(Time, Pattern a)] -> Pattern a
timecat = timeCat
--- | 'overlay' combines two 'Pattern's into a new pattern, so that
--- their events are combined over time.
+{- | @overlay@ combines two 'Pattern's into a new pattern, so that their events
+are combined over time. For example, the following two lines are equivalent:
+
+> d1 $ sound (overlay "bd sn:2" "cp*3")
+> d1 $ sound "[bd sn:2, cp*3]"
+
+@overlay@ is equal to '<>',
+
+> (<>) :: Semigroup a => a -> a -> a
+
+which can thus be used as an infix operator equivalent of 'overlay':
+
+> d1 $ sound ("bd sn:2" <> "cp*3")
+-}
overlay :: Pattern a -> Pattern a -> Pattern a
overlay = (<>)
--- | 'stack' combines a list of 'Pattern's into a new pattern, so that
--- their events are combined over time.
+{- | 'stack' combines a list of 'Pattern's into a new pattern, so that their
+events are combined over time, i.e., all of the patterns in the list are played
+simultaneously.
+
+> d1 $ stack [
+> sound "bd bd*2",
+> sound "hh*2 [sn cp] cp future*4",
+> sound "arpy" +| n "0 .. 15"
+> ]
+
+This is particularly useful if you want to apply a function or synth control
+pattern to multiple patterns at once:
+
+> d1 $ whenmod 5 3 (striate 3) $ stack [
+> sound "bd bd*2",
+> sound "hh*2 [sn cp] cp future*4",
+> sound "arpy" +| n "0 .. 15"
+> ] # speed "[[1 0.8], [1.5 2]*2]/3"
+-}
stack :: [Pattern a] -> Pattern a
stack = foldr overlay silence
@@ -343,8 +430,28 @@ stack = foldr overlay silence
(~>) :: Pattern Time -> Pattern a -> Pattern a
(~>) = tParam rotR
--- | Slow down a pattern by the factors in the given time pattern, 'squeezing'
--- the pattern to fit the slot given in the time pattern
+{-| Slow down a pattern by the factors in the given time pattern, "squeezing"
+ the pattern to fit the slot given in the time pattern. It is the slow analogue
+ to 'fastSqueeze'.
+
+ If the time pattern only has a single value in a cycle, @slowSqueeze@ becomes equivalent to slow. These are equivalent:
+
+ > d1 $ slow "<2 4>" $ s "bd*8"
+ > d1 $ slowSqueeze "<2 4>" $ s "bd*8"
+
+ When the time pattern has multiple values, however, the behavior is a little
+ different. Instead, a slowed version of the pattern will be made for each value
+ in the time pattern, and they’re all combined together in a cycle according to
+ the structure of the time pattern. For example, these are equivalent:
+
+ > d1 $ slowSqueeze "2 4 8 16" $ s "bd*8"
+ > d1 $ s "bd*4 bd*2 bd bd/2"
+
+ as are these:
+
+ > d1 $ slowSqueeze "2 4 [8 16]" $ s "bd*8"
+ > d1 $ s "bd*4 bd*2 [bd bd/2]"
+-}
slowSqueeze :: Pattern Time -> Pattern a -> Pattern a
slowSqueeze = tParamSqueeze _slow
@@ -353,17 +460,18 @@ sparsity :: Pattern Time -> Pattern a -> Pattern a
sparsity = slow
{- | Plays a portion of a pattern, specified by a time arc (start and end time).
-The new resulting pattern is played over the time period of the original pattern:
+ 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"
-@
+ > 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:
+ In the pattern above, @zoom@ is used with an arc from 25% to 75%. It is
+ equivalent to:
-@
-d1 $ sound "hh*3 [sn bd]*2"
-@
+ > d1 $ sound "hh*3 [sn bd]*2"
+
+ Here’s an example of it being used with a conditional:
+
+ > d1 $ every 4 (zoom (0.25, 0.75)) $ sound "bd*2 hh*3 [sn bd]*2 drum"
-}
zoom :: (Time, Time) -> Pattern a -> Pattern a
zoom (s,e) = zoomArc (Arc s e)
@@ -373,10 +481,12 @@ zoomArc (Arc s e) p = splitQueries $
withResultArc (mapCycle ((/d) . subtract s)) $ withQueryArc (mapCycle ((+s) . (*d))) p
where d = e-s
--- | @fastGap@ is similar to 'fast' but maintains its cyclic
--- alignment. For example, @fastGap 2 p@ would squash the events in
--- pattern @p@ into the first half of each cycle (and the second
--- halves would be empty). The factor should be at least 1
+{-| @fastGap@ is similar to 'fast' but maintains its cyclic alignment, i.e.,
+ rather than playing the pattern multiple times, it instead leaves a gap in
+ the remaining space of the cycle. For example, @fastGap 2 p@ would squash the
+ events in pattern @p@ into the first half of each cycle (and the second halves
+ would be empty). The factor should be at least 1.
+-}
fastGap :: Pattern Time -> Pattern a -> Pattern a
fastGap = tParam _fastGap
@@ -384,6 +494,24 @@ fastGap = tParam _fastGap
densityGap :: Pattern Time -> Pattern a -> Pattern a
densityGap = fastGap
+{-|
+ @compress@ takes a pattern and squeezes it within the specified time span (i.e.
+ the ‘arc’). The new resulting pattern is a sped up version of the original.
+
+ > d1 $ compress (1/4, 3/4) $ s "[bd sn]!"
+
+ In the above example, the pattern will play in an arc spanning from 25% to 75%
+ of the duration of a cycle. It is equivalent to:
+
+ > d1 $ s "~ [bd sn]! ~"
+
+ Another example, where all events are different:
+
+ > d1 $ compress (1/4, 3/4) $ n (run 4) # s "arpy"
+
+ It differs from 'zoom' in that it preserves the original pattern but it speeds
+ up its events so to match with the new time period.
+-}
compress :: (Time,Time) -> Pattern a -> Pattern a
compress (s,e) = compressArc (Arc s e)
@@ -403,8 +531,24 @@ fastRepeatCycles n p = cat (replicate n p)
-- | Functions which work on other functions (higher order functions)
--- | @every n f p@ applies the function @f@ to @p@, but only affects
--- every @n@ cycles.
+{- | @every n f p@ applies the function @f@ to @p@, but only affects
+ every @n@ cycles.
+
+ It takes three inputs: how often the function should be applied (e.g. 3 to
+ apply it every 3 cycles), the function to be applied, and the pattern you are
+ applying it to. For example: to reverse a pattern every three cycles (and for
+ the other two play it normally)
+
+ > d1 $ every 3 rev $ n "0 1 [~ 2] 3" # sound "arpy"
+
+ Note that if the function you’re applying requires additional parameters
+ itself (such as fast 2 to make a pattern twice as fast), then you’ll need to
+ wrap it in parenthesis, like so:
+
+ > d1 $ every 3 (fast 2) $ n "0 1 [~ 2] 3" # sound "arpy"
+
+ Otherwise, the every function will think it is being passed too many parameters.
+-}
every :: Pattern Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
every tp f p = innerJoin $ (\t -> _every t f p) <$> tp
@@ -412,30 +556,55 @@ _every :: Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_every 0 _ p = p
_every n f p = when ((== 0) . (`mod` n)) f p
--- | @every n o f'@ is like @every n f@ with an offset of @o@ cycles
+{-| @every' n o f p@ is like @every n f p@ but with an offset of @o@ cycles.
+
+ For example, @every' 3 0 (fast 2)@ will speed up the cycle on cycles 0,3,6,…
+ whereas @every' 3 1 (fast 2)@ will transform the pattern on cycles 1,4,7,….
+
+ With this in mind, setting the second argument of @every'@ to 0 gives the
+ equivalent every function. For example, every 3 is equivalent to every' 3 0.
+
+ The @every@ functions can be used to silence a full cycle or part of a cycle
+ by using silent or mask "~". Mask provides additional flexibility to turn on/off
+ individual steps.
+
+ > d1 $ every 3 silent $ n "2 9 11 2" # s "hh27"
+ > d1 $ every 3 (mask "~") $ n "2 9 10 2" # s "hh27"
+ > d1 $ every 3 (mask "0 0 0 0") $ n "2 9 11 2" # s "hh27"
+-}
every' :: Pattern Int -> Pattern Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
every' np op f p = do { n <- np; o <- op; _every' n o f p }
_every' :: Int -> Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_every' n o = when ((== o) . (`mod` n))
--- | @foldEvery ns f p@ applies the function @f@ to @p@, and is applied for
--- each cycle in @ns@.
+{- | @foldEvery ns f p@ applies the function @f@ to @p@, and is applied for
+ each cycle in @ns@.
+
+ It is similar to chaining multiple @every@ functions together. It transforms
+ a pattern with a function, once per any of the given number of cycles. If a
+ particular cycle is the start of more than one of the given cycle periods, then
+ it it applied more than once.
+
+ > d1 $ foldEvery [5,3] (|+ n 1) $ s "moog" # legato 1
+
+ The first moog samples are tuned to C2, C3 and C4. Note how on cycles that are
+ multiples of 3 or 5 the pitch is an octave higher, and on multiples of 15 the
+ pitch is two octaves higher, as the transformation is applied twice.
+-}
foldEvery :: [Int] -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
foldEvery ns f p = foldr (`_every` f) p ns
{-|
-Only `when` the given test function returns `True` the given pattern
-transformation is applied. The test function will be called with the
-current cycle as a number.
+The given pattern transformation is applied only @when@ the given test function
+returns @True@. The test function will be called with the current cycle as
+a number.
-@
-d1 $ when ((elem '4').show)
- (striate 4)
- $ sound "hh hc"
-@
+> d1 $ when (elem '4' . show)
+> (striate 4)
+> $ sound "hh hc"
-The above will only apply `striate 4` to the pattern if the current
+The above will only apply @striate 4@ to the pattern if the current
cycle number contains the number 4. So the fourth cycle will be
striated and the fourteenth and so on. Expect lots of striates after
cycle number 399.
@@ -445,7 +614,14 @@ when test f p = splitQueries $ p {query = apply}
where apply st | test (floor $ start $ arc st) = query (f p) st
| otherwise = query p st
--- | Like 'when', but works on continuous time values rather than cycle numbers.
+{- | Like 'when', but works on continuous time values rather than cycle numbers.
+ The following will apply @# speed 2@ only when the remainder of the current
+ @Time@ divided by 2 is less than 0.5:
+
+ > d1 $ whenT ((< 0.5) . (flip Data.Fixed.mod' 2))
+ > (# speed 2)
+ > $ sound "hh(4,8) hc(3,8)"
+-}
whenT :: (Time -> Bool) -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
whenT test f p = splitQueries $ p {query = apply}
where apply st | test (start $ arc st) = query (f p) st
diff --git a/src/Sound/Tidal/Params.hs b/src/Sound/Tidal/Params.hs
index cd229dbfd..ce443cfba 100644
--- a/src/Sound/Tidal/Params.hs
+++ b/src/Sound/Tidal/Params.hs
@@ -31,7 +31,7 @@ import Data.Maybe (fromMaybe)
import Data.Word (Word8)
import Data.Fixed (mod')
--- | group multiple params into one
+-- | Group multiple params into one.
grp :: [String -> ValueMap] -> Pattern String -> ControlPattern
grp [] _ = empty
grp fs p = splitby <$> p
@@ -50,7 +50,7 @@ mI name v = fromMaybe Map.empty $ do i <- readMaybe v
mS :: String -> String -> ValueMap
mS name v = Map.singleton name (VS v)
--- | Param makers
+-- * Param makers
pF :: String -> Pattern Double -> ControlPattern
pF name = fmap (Map.singleton name . VF)
@@ -119,7 +119,7 @@ pStateListF name sName = pStateList name sName . map VF
pStateListS :: String -> String -> [String] -> ControlPattern
pStateListS name sName = pStateList name sName . map VS
--- | Grouped params
+-- * Grouped params
sound :: Pattern String -> ControlPattern
sound = grp [mS "s", mF "n"]
@@ -139,6 +139,13 @@ nrpnn = pI "nrpn"
nrpnv :: Pattern Int -> ControlPattern
nrpnv = pI "val"
+{-| @grain'@ is a shortcut to join a @begin@ and @end@
+
+ These are equivalent:
+
+ > d1 $ slow 2 $ s "bev" # grain' "0.2:0.3" # legato 1
+ > d1 $ slow 2 $ s "bev" # begin 0.2 # end 0.3 # legato 1
+-}
grain' :: Pattern String -> ControlPattern
grain' = grp [mF "begin", mF "end"]
@@ -212,11 +219,23 @@ drumN "ms" = 86
drumN "os" = 87
drumN _ = 0
--- Generated params
+-- * Generated params
+
+{- | A pattern of numbers that speed up (or slow down) samples while they play.
--- | a pattern of numbers that speed up (or slow down) samples while they play.
+ In the following example, the sound starts at the original pitch and gets
+ higher as it plays:
+
+ > d1 $ s "arpy" # accelerate 2
+
+ You can use a negative number to make the sound get lower. In this example, a
+ different acceleration is applied to each played note using state values:
+
+ > d1 $ arp "up" $ note "c'maj'4" # s "arpy" # accelerateTake "susan" [0.2,1,-1]
+-}
accelerate :: Pattern Double -> ControlPattern
accelerate = pF "accelerate"
+
accelerateTake :: String -> [Double] -> ControlPattern
accelerateTake name xs = pStateListF "accelerate" name xs
accelerateCount :: String -> ControlPattern
@@ -227,7 +246,11 @@ accelerateCountTo name ipat = innerJoin $ (\i -> pStateF "accelerate" name (mayb
acceleratebus :: Pattern Int -> Pattern Double -> ControlPattern
acceleratebus _ _ = error $ "Control parameter 'accelerate' can't be sent to a bus."
--- | like @gain@, but linear.
+{-| Controls the amplitude (volume) of the sound. Like 'gain', but linear.
+ Default value is 0.4.
+
+ > d1 $ s "arpy" # amp "<0.4 0.8 0.2>"
+-}
amp :: Pattern Double -> ControlPattern
amp = pF "amp"
ampTake :: String -> [Double] -> ControlPattern
@@ -295,7 +318,16 @@ bandqbus busid pat = (pF "bandq" pat) # (pI "^bandq" busid)
bandqrecv :: Pattern Int -> ControlPattern
bandqrecv busid = pI "^bandq" busid
--- | 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.
+{- | @begin@ receives a pattern of numbers from 0 to 1 and skips the beginning
+of each sample by the indicated proportion. I.e., 0 would play the sample from
+the start, 1 would skip the whole sample, and 0.25 would cut off the first
+quarter.
+
+In this example, the first 3 @ade@ samples are played on every cycle, but the
+start point from which they are played changes on each cycle:
+
+> d1 $ n "0 1 2" # s "ade" # begin "<0 0.25 0.5 0.75>" # legato 1
+-}
begin :: Pattern Double -> ControlPattern
begin = pF "begin"
beginTake :: String -> [Double] -> ControlPattern
@@ -660,7 +692,13 @@ controlCountTo name ipat = innerJoin $ (\i -> pStateF "control" name (maybe 0 ((
controlbus :: Pattern Int -> Pattern Double -> ControlPattern
controlbus _ _ = error $ "Control parameter 'control' can't be sent to a bus."
--- |
+{-| A control pattern; 'setcps' is the standalone function.
+
+ Patterns don’t (yet) have independent tempos though, if you change it on one
+ pattern, it changes on all of them.
+
+ > p "cpsfun" $ s "bd sd(3,8)" # cps (slow 8 $ 0.5 + saw)
+-}
cps :: Pattern Double -> ControlPattern
cps = pF "cps"
cpsTake :: String -> [Double] -> ControlPattern
@@ -913,7 +951,14 @@ durbus busid pat = (pF "dur" pat) # (pI "^dur" busid)
durrecv :: Pattern Int -> ControlPattern
durrecv busid = pI "^dur" busid
--- | 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.
+{- | Similar to `begin`, but cuts the end off samples, shortening them; e.g.
+ 0.75 to cut off the last quarter of each sample.
+
+ > d1 $ s "bev" >| begin 0.5 >| end "[0.65 0.55]"
+
+ The example above will play the sample two times for cycle, but the second time
+ will play a shorter segment than the first time, creating a kind of canon effect.
+-}
end :: Pattern Double -> ControlPattern
end = pF "end"
endTake :: String -> [Double] -> ControlPattern
@@ -1098,7 +1143,24 @@ fshiftphasebus busid pat = (pF "fshiftphase" pat) # (pI "^fshiftphase" busid)
fshiftphaserecv :: Pattern Int -> ControlPattern
fshiftphaserecv busid = pI "^fshiftphase" busid
--- | a pattern of numbers that specify volume. Values less than 1 make the sound quieter. Values greater than 1 make the sound louder. For the linear equivalent, see @amp@.
+{- | Used to control the amplitude (volume) of the sound. Values less than 1
+make the sound quieter and values greater than 1 make the sound louder.
+
+@gain@ uses a power function, so the volume change around 1 is subtle, but it
+gets more noticeable as it increases or decreases. Typical values for @gain@ are
+between 0 and 1.5.
+
+For the linear equivalent, see 'amp'.
+
+> d1 $ s "arpy" # gain 0.8
+
+This plays the first arpy sample at a quieter level than the default.
+
+> d1 $ s "ab*16" # gain (range 0.8 1.3 $ sine)
+
+This plays a hihat sound, 16 times per cycle, with a @gain@ moving from 0.8 to 1.3
+following a sine wave.
+-}
gain :: Pattern Double -> ControlPattern
gain = pF "gain"
gainTake :: String -> [Double] -> ControlPattern
@@ -1877,7 +1939,7 @@ ophatdecaybus busid pat = (pF "ophatdecay" pat) # (pI "^ophatdecay" busid)
ophatdecayrecv :: Pattern Int -> ControlPattern
ophatdecayrecv busid = pI "^ophatdecay" busid
--- | 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.
+-- | 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 :: Pattern Int -> ControlPattern
orbit = pI "orbit"
orbitTake :: String -> [Double] -> ControlPattern
@@ -2126,7 +2188,7 @@ progNumCountTo name ipat = innerJoin $ (\i -> pStateF "progNum" name (maybe 0 ((
progNumbus :: Pattern Int -> Pattern Double -> ControlPattern
progNumbus _ _ = error $ "Control parameter 'progNum' can't be sent to a bus."
--- | used in SuperDirt softsynths as a control rate or 'speed'
+-- | used in SuperDirt softsynths as a control rate or "speed"
rate :: Pattern Double -> ControlPattern
rate = pF "rate"
rateTake :: String -> [Double] -> ControlPattern
@@ -2662,7 +2724,20 @@ songPtrCountTo name ipat = innerJoin $ (\i -> pStateF "songPtr" name (maybe 0 ((
songPtrbus :: Pattern Int -> Pattern Double -> ControlPattern
songPtrbus _ _ = error $ "Control parameter 'songPtr' can't be sent to a bus."
--- | a pattern of numbers which changes the speed of sample playback, i.e. a cheap way of changing pitch. Negative values will play the sample backwards!
+{-|
+ A pattern of numbers which changes the speed of sample playback which also
+ changes pitch. Negative values will play the sample backwards.
+
+ > d1 $ slow 5 $ s "sax:5" # legato 1 # speed 0.5
+
+ This will play the @sax:5@ sample at half its rate. As a result, the sample will
+ last twice the normal time, and will be pitched a whole octave lower. This is
+ equivalent to @d1 $ slow 5 $ s "sax:5" # legato 1 |- note 12@.
+
+ > d1 $ fast 2 $ s "breaks125:1" # cps (125/60/4) # speed (-2)
+
+ In the above example, the break (which lasts for exactly one bar at 125 BPM), will be played backwards, and at double speed (so, we use @fast 2@ to fill the whole cycle).
+-}
speed :: Pattern Double -> ControlPattern
speed = pF "speed"
speedTake :: String -> [Double] -> ControlPattern
@@ -2735,7 +2810,22 @@ stuttertimebus busid pat = (pF "stuttertime" pat) # (pI "^stuttertime" busid)
stuttertimerecv :: Pattern Int -> ControlPattern
stuttertimerecv busid = pI "^stuttertime" busid
--- |
+{-|
+ A pattern of numbers that indicates the total duration of sample playback in seconds.
+
+ This @sustain@ refers to the whole playback duration and is not to be confused with the sustain level of a typical ADSR envelope.
+
+ > d1 $ fast 2 $ s "breaks125:1" # cps (120/60/4) # sustain 1
+
+ At 120 BPM, a cycle lasts for two seconds. In the above example, we cut the
+ sample so it plays just for one second, and repeat this part two times, so we
+ fill the whole cycle. Note that sample pitch isn’t modified.
+
+ > d1 $ s "breaks125:2!3" # cps (120/60/4) # sustain "0.4 0.2 0.4" # begin "0 0 0.4"
+
+ Here, we take advantage that sustain receives a pattern to build a different
+ break from the original sample.
+-}
sustain :: Pattern Double -> ControlPattern
sustain = pF "sustain"
sustainTake :: String -> [Double] -> ControlPattern
@@ -2763,9 +2853,25 @@ sustainpedalbus busid pat = (pF "sustainpedal" pat) # (pI "^sustainpedal" busid)
sustainpedalrecv :: Pattern Int -> ControlPattern
sustainpedalrecv busid = pI "^sustainpedal" busid
--- | time stretch amount
+{- |
+ @timescale@ is the main function used to activate time-stretching, and usually
+ the only one you need. It receives a single parameter which is the stretching
+ rate to apply.
+
+ You can use any positive number as the ratio, but the particular method used is
+ designed for ratios greater than 1, and work reasonably well for values between
+ 0.1 and 3.
+
+ > d1 $ slow 2 $ s "breaks152" # legato 1 # timescale (152/130) # cps (130/60/4)
+
+ In the example above, we set tempo at 130 beats per minute. But we want to play
+ one of the @breaks152@ samples, which are, as indicated, at 152 BPM. So, the
+ ratio we want is 152 over 130. This will slow down the sample to fit in our 130
+ BPM tempo.
+-}
timescale :: Pattern Double -> ControlPattern
timescale = pF "timescale"
+
timescaleTake :: String -> [Double] -> ControlPattern
timescaleTake name xs = pStateListF "timescale" name xs
timescaleCount :: String -> ControlPattern
@@ -2776,9 +2882,39 @@ timescaleCountTo name ipat = innerJoin $ (\i -> pStateF "timescale" name (maybe
timescalebus :: Pattern Int -> Pattern Double -> ControlPattern
timescalebus _ _ = error $ "Control parameter 'timescale' can't be sent to a bus."
--- | time stretch window size
+{- | Time stretch window size.
+
+The algorithm used to time-stretch a sample divides a sample in many little parts, modifies them, and puts them all together again. It uses one particular parameter, called @windowSize@, which is the length of each sample part.
+
+The @windowSize@ value is automatically calculated, but can be changed with @timescalewin@. The @windowSize@ value is multiplied by the number provided.
+
+@timescalewin@ can be used to improve the quality of time-stretching for some samples, or simply as an effect.
+
+Consider the following two examples. In the first one, @timescalewin 0.01@ makes
+the window size a lot smaller, and the extreme chopping of the sample causes
+a rougher sound. In the second one, @timescalewin 10@ makes the chunks a lot
+bigger. The method used overlaps the treated chunks when recomposing the sample,
+and, with the bigger window size, this overlap is noticeable and causes a kind
+of delay effect.
+
+> d1 $ slow 2
+> $ s "breaks152"
+> # legato 1
+> # timescale (152/130)
+> # timescalewin 0.01
+> # cps (130/60/4)
+
+> d1 $ slow 2
+> $ s "breaks152"
+> # legato 1
+> # timescale (152/130)
+> # timescalewin 10
+> # cps (130/60/4)
+
+-}
timescalewin :: Pattern Double -> ControlPattern
timescalewin = pF "timescalewin"
+
timescalewinTake :: String -> [Double] -> ControlPattern
timescalewinTake name xs = pStateListF "timescalewin" name xs
timescalewinCount :: String -> ControlPattern
@@ -2902,7 +3038,21 @@ uidCountTo name ipat = innerJoin $ (\i -> pStateF "uid" name (maybe 0 ((`mod'` i
uidbus :: Pattern Int -> Pattern Double -> ControlPattern
uidbus _ _ = error $ "Control parameter 'uid' can't be sent to a bus."
--- | used in conjunction with `speed`, accepts values of "r" (rate, default behavior), "c" (cycles), or "s" (seconds). Using `unit "c"` means `speed` will be interpreted in units of cycles, e.g. `speed "1"` means samples will be stretched to fill a cycle. Using `unit "s"` means the playback speed will be adjusted so that the duration is the number of seconds specified by `speed`.
+{- |
+ Used in conjunction with `speed`. It accepts values of @r@ (rate, default
+ behavior), @c@ (cycles), or @s@ (seconds). Using @unit "c"@ means `speed`
+ will be interpreted in units of cycles, e.g. @speed "1"@ means samples will be
+ stretched to fill a cycle. Using @unit "s"@ means the playback speed will be
+ adjusted so that the duration is the number of seconds specified by `speed`.
+
+ In the following example, @speed 2@ means that samples will be stretched to fill
+ half a cycle:
+
+ > d1 $ stack [
+ > s "sax:5" # legato 1 # speed 2 # unit "c",
+ > s "bd*2"
+ > ]
+-}
unit :: Pattern String -> ControlPattern
unit = pS "unit"
unitTake :: String -> [Double] -> ControlPattern
@@ -3025,7 +3175,7 @@ xsdelayrecv busid = pI "^xsdelay" busid
--- aliases
+-- * Aliases
voi :: Pattern Double -> ControlPattern
voi = voice
diff --git a/src/Sound/Tidal/Pattern.hs b/src/Sound/Tidal/Pattern.hs
index 60b6374ae..8fc13c4fc 100644
--- a/src/Sound/Tidal/Pattern.hs
+++ b/src/Sound/Tidal/Pattern.hs
@@ -74,40 +74,40 @@ instance Applicative Pattern where
v)
$ cycleArcsInArc a
- -- | In each of `a <*> b`, `a <* b` and `a *> b`
+ -- | In each of @a <*> b@, @a <* b@ and @a *> b@
-- (using the definitions from this module, not the Prelude),
-- the time structure of the result
- -- depends on the structures of both `a` and `b`.
- -- They all result in `Event`s with identical `part`s and `value`s.
- -- However, their `whole`s are different.
+ -- depends on the structures of both @a@ and @b@.
+ -- They all result in @Event@s with identical @part@s and @value@s.
+ -- However, their @whole@s are different.
--
- -- For instance, `listToPat [(+1), (+2)] <*> "0 10 100"`
- -- gives the following 4-`Event` cycle:
+ -- For instance, @listToPat [(+1), (+2)] <*> "0 10 100"@
+ -- gives the following 4-@Event@ cycle:
-- > (0>⅓)|1
-- > (⅓>½)|11
-- > (½>⅔)|12
-- > (⅔>1)|102
- -- If we use `<*` instead, we get this:
+ -- If we use @<*@ instead, we get this:
-- > (0>⅓)-½|1
-- > 0-(⅓>½)|11
-- > (½>⅔)-1|12
-- > ½-(⅔>1)|102
- -- And if we use `*>`, we get this:
+ -- And if we use @*>@, we get this:
-- > (0>⅓)|1
-- > (⅓>½)-⅔|11
-- > ⅓-(½>⅔)|12
-- > (⅔>1)|102
(<*>) = applyPatToPatBoth
--- | Like <*>, but the 'wholes' come from the left
+-- | Like @<*>@, but the "wholes" come from the left
(<*) :: Pattern (a -> b) -> Pattern a -> Pattern b
(<*) = applyPatToPatLeft
--- | Like <*>, but the 'wholes' come from the right
+-- | Like @<*>@, but the "wholes" come from the right
(*>) :: Pattern (a -> b) -> Pattern a -> Pattern b
(*>) = applyPatToPatRight
--- | Like <*>, but the 'wholes' come from the left
+-- | Like @<*>@, but the "wholes" come from the left
(<<*) :: Pattern (a -> b) -> Pattern a -> Pattern b
(<<*) = applyPatToPatSqueeze
@@ -162,9 +162,11 @@ applyPatToPatSqueeze :: Pattern (a -> b) -> Pattern a -> Pattern b
applyPatToPatSqueeze pf px = squeezeJoin $ (\f -> f <$> px) <$> pf
-- * Monad and friends
-
+--
+-- $monadAndFriends
+--
-- Note there are four ways of joining - the default 'unwrap' used by @>>=@, as well
--- as innerJoin, innerJoin and squeezeJoin.
+-- as @innerJoin@, @innerJoin@ and @squeezeJoin@.
instance Monad Pattern where
return = pure
@@ -504,12 +506,56 @@ focusArc :: Arc -> Pattern a -> Pattern a
focusArc (Arc s e) p = (cyclePos s) `rotR` (_fast (1/(e-s)) p)
--- | Speed up a pattern by the given time pattern
+{-| Speed up a pattern by the given time pattern.
+
+For example, the following will play the sound pattern @"bd sn kurt"@ twice as
+fast (i.e., so it repeats twice per cycle), and the vowel pattern three times
+as fast:
+
+> d1 $ sound (fast 2 "bd sn kurt")
+> # fast 3 (vowel "a e o")
+
+The first parameter can be patterned to, for example, play the pattern at twice
+the speed for the first half of each cycle and then four times the speed for the
+second half:
+
+> d1 $ fast "2 4" $ sound "bd sn kurt cp"
+-}
fast :: Pattern Time -> Pattern a -> Pattern a
fast = tParam _fast
--- | Slow down a pattern by the factors in the given time pattern, 'squeezing'
--- the pattern to fit the slot given in the time pattern
+{-| @fastSqueeze@ speeds up a pattern by a time pattern given as input,
+ squeezing the resulting pattern inside one cycle and playing the original
+ pattern at every repetition.
+
+ To better understand how it works, compare it with 'fast':
+
+ >>> print $ fast "1 2" $ s "bd sn"
+ (0>½)|s: "bd"
+ (½>¾)|s: "bd"
+ (¾>1)|s: "sn"
+
+ This will give @bd@ played in the first half cycle, and @bd sn@ in the second
+ half. On the other hand, using fastSqueeze;
+
+ >>> print $ fastSqueeze "1 2" $ s "bd sn"
+ (0>¼)|s: "bd"
+ (¼>½)|s: "sn"
+ (½>⅝)|s: "bd"
+ (⅝>¾)|s: "sn"
+ (¾>⅞)|s: "bd"
+ (⅞>1)|s: "sn"
+
+ The original pattern will play in the first half, and two repetitions of the
+ original pattern will play in the second half. That is, every repetition
+ contains the whole pattern.
+
+ If the time pattern has a single value, it becomes equivalent to 'fast':
+
+ > d1 $ fastSqueeze 2 $ s "bd sn"
+ > d1 $ fast 2 $ s "bd sn"
+ > d1 $ s "[bd sn]*2"
+-}
fastSqueeze :: Pattern Time -> Pattern a -> Pattern a
fastSqueeze = tParamSqueeze _fast
@@ -522,7 +568,15 @@ _fast rate pat | rate == 0 = silence
| rate < 0 = rev $ _fast (negate rate) pat
| otherwise = withResultTime (/ rate) $ withQueryTime (* rate) pat
--- | Slow down a pattern by the given time pattern
+{-| Slow down a pattern by the given time pattern.
+
+ For example, the following will play the sound pattern @"bd sn kurt"@ twice as
+ slow (i.e., so it repeats once every two cycles), and the vowel pattern three
+ times as slow:
+
+ > d1 $ sound (slow 2 "bd sn kurt")
+ > # slow 3 (vowel "a e o")
+-}
slow :: Pattern Time -> Pattern a -> Pattern a
slow = tParam _slow
_slow :: Time -> Pattern a -> Pattern a
@@ -542,16 +596,47 @@ _fastGap r p = splitQueries $
where mungeQuery t = sam t + min 1 (r' * cyclePos t)
a' = (\(Arc s e) -> Arc (mungeQuery s) (mungeQuery e)) a
--- | Shifts a pattern back in time by the given amount, expressed in cycles
+{-| Shifts a pattern back in time by the given amount, expressed in cycles.
+
+ This will skip to the fourth cycle:
+
+ > do
+ > resetCycles
+ > d1 $ rotL 4 $ seqP
+ > [ (0, 12, sound "bd bd*2")
+ > , (4, 12, sound "hh*2 [sn cp] cp future*4")
+ > , (8, 12, sound (samples "arpy*8" (run 16)))
+ > ]
+
+ Useful when building and testing out longer sequences.
+-}
rotL :: Time -> Pattern a -> Pattern a
rotL t p = withResultTime (subtract t) $ withQueryTime (+ t) p
--- | Shifts a pattern forward in time by the given amount, expressed in cycles
+{-| Shifts a pattern forward in time by the given amount, expressed in cycles.
+ Opposite of 'rotL'.
+-}
rotR :: Time -> Pattern a -> Pattern a
rotR t = rotL (negate t)
--- | @rev p@ returns @p@ with the event positions in each cycle
--- reversed (or mirrored).
+{- | @rev p@ returns @p@ with the event positions in each cycle reversed (or
+ mirrored).
+
+ For example rev @"1 [~ 2] ~ 3"@ is equivalent to rev @"3 ~ [2 ~] 1"@.
+
+ Note that @rev@ reverses on a cycle-by-cycle basis. This means that @rev (slow
+ 2 "1 2 3 4")@ would actually result in @(slow 2 "2 1 4 3")@. This is because the
+ @slow 2@ makes the repeating pattern last two cycles, each of which is reversed
+ independently.
+
+ In practice rev is generally used with conditionals, for example with every:
+
+ > d1 $ every 3 rev $ n "0 1 [~ 2] 3" # sound "arpy"
+
+ or 'jux':
+
+ > d1 $ jux rev $ n (iter 4 "0 1 [~ 2] 3") # sound "arpy"
+-}
rev :: Pattern a -> Pattern a
rev p =
splitQueries $ p {
diff --git a/src/Sound/Tidal/Safe/Boot.hs b/src/Sound/Tidal/Safe/Boot.hs
index 7350eaed5..b9a33bed0 100644
--- a/src/Sound/Tidal/Safe/Boot.hs
+++ b/src/Sound/Tidal/Safe/Boot.hs
@@ -42,8 +42,50 @@ first = streamFirst
asap = once
nudgeAll = streamNudgeAll
all = streamAll
+
+{-|
+ Resets the cycle count back to 0.
+ Useful to make sure a pattern or set of patterns start from the beginning:
+
+ > do
+ > resetCycles
+ > d1 $ s "bd hh hh hh"
+ > d2 $ s "ade" # cut 1
+
+ Cycle count affects all patterns, so if there are any active, all of them will immediately jump to the beginning.
+ @resetCycles@ is also userful in multi-user Tidal.
+
+ Also see 'setCycle', 'getnow'.
+-}
resetCycles = streamResetCycles
+
+{-|
+ Adjusts the number of cycles per second, i.e., tempo.
+ Accepts integers, decimals, and fractions.
+
+ The default number of cycles per second is 0.5625, equivalent to 135\/60\/4, i.e.,
+ 135 beats per minute if there are 4 beats per cycle.
+
+ Representing cycles per second using fractions has the advantage of being more
+ human-readable and more closely aligned with how tempo is commonly represented
+ in music as beats per minute (bpm). For example, techno has a typical range of
+ 120-140 bpm and house has a range of 115-130 bpm. To set the tempo in Tidal to
+ fast house, e.g.,: @setcps (130\/60\/4)@.
+
+ The following sound the same:
+
+ > setcps (130/60/4)
+ > d1 $ n "1" # s "kick kick kick kick"
+
+ and
+
+ > setcps (130/60/1)
+ > d1 $ n "1" # s "kick"
+-}
setcps = asap . cps
+
+-- * Transitions
+
xfade i = transition True (Sound.Tidal.Transition.xfadeIn 4) i
xfadeIn i t = transition True (Sound.Tidal.Transition.xfadeIn t) i
histpan i t = transition True (Sound.Tidal.Transition.histpan t) i
diff --git a/src/Sound/Tidal/Safe/Context.hs b/src/Sound/Tidal/Safe/Context.hs
index 941a105af..afb3754dd 100644
--- a/src/Sound/Tidal/Safe/Context.hs
+++ b/src/Sound/Tidal/Safe/Context.hs
@@ -53,7 +53,7 @@ module Sound.Tidal.Safe.Context
where
import Data.Ratio as C
-import Sound.Tidal.Config as C
+import Sound.Tidal.Stream.Config as C
import Sound.Tidal.Control as C
import Sound.Tidal.Core as C
import Sound.Tidal.Params as C
@@ -61,8 +61,9 @@ import Sound.Tidal.ParseBP as C
import Sound.Tidal.Pattern as C
import Sound.Tidal.Scales as C
import Sound.Tidal.Simple as C
-import Sound.Tidal.Stream
- (startTidal, superdirtTarget, Target(..))
+import Sound.Tidal.Stream.Target (superdirtTarget)
+import Sound.Tidal.Stream.Types (Target(..))
+import Sound.Tidal.Stream.Main (startTidal)
-- import Sound.Tidal.Transition as C
import Sound.Tidal.UI as C
import Sound.Tidal.Version as C
@@ -79,7 +80,7 @@ exec :: Stream -> Op r -> IO r
exec stream (Op m) = runReaderT m stream
op1 f = Op $ do a <- ask; lift $ f a
-op2 f b = Op $ do a <- ask; lift $ f a b
+op2 f b = Op $ do a <- ask; lift $ f a b
op3 f b c = Op $ do a <- ask; lift $ f a b c
op4 f b c d = Op $ do a <- ask; lift $ f a b c d
op5 f b c d e = Op $ do a <- ask; lift $ f a b c d e
diff --git a/src/Sound/Tidal/Scales.hs b/src/Sound/Tidal/Scales.hs
index 77c2d3922..4c2538152 100644
--- a/src/Sound/Tidal/Scales.hs
+++ b/src/Sound/Tidal/Scales.hs
@@ -23,21 +23,24 @@ import Data.Maybe
import Sound.Tidal.Pattern
import Sound.Tidal.Utils
--- five notes scales
+-- * Scale definitions
+
+-- ** Five notes scales
minPent :: Fractional a => [a]
minPent = [0,3,5,7,10]
majPent :: Fractional a => [a]
majPent = [0,2,4,7,9]
--- another mode of major pentatonic
+-- | Another mode of major pentatonic
ritusen :: Fractional a => [a]
ritusen = [0,2,5,7,9]
--- another mode of major pentatonic
+-- | Another mode of major pentatonic
egyptian :: Fractional a => [a]
egyptian = [0,2,5,7,10]
---
+-- *** Other scales
+
kumai :: Fractional a => [a]
kumai = [0,2,3,7,9]
hirajoshi :: Fractional a => [a]
@@ -51,13 +54,14 @@ indian = [0,4,5,7,10]
pelog :: Fractional a => [a]
pelog = [0,1,3,7,8]
---
+-- *** More scales
+
prometheus :: Fractional a => [a]
prometheus = [0,2,4,6,11]
scriabin :: Fractional a => [a]
scriabin = [0,1,4,7,9]
--- han chinese pentatonic scales
+-- *** Han Chinese pentatonic scales
gong :: Fractional a => [a]
gong = [0,2,4,7,9]
shang :: Fractional a => [a]
@@ -69,7 +73,7 @@ zhi = [0,2,5,7,9]
yu :: Fractional a => [a]
yu = [0,3,5,7,10]
--- 6 note scales
+-- ** 6 note scales
whole' :: Fractional a => [a]
whole' = [0,2,4,6,8,10]
augmented :: Fractional a => [a]
@@ -77,7 +81,7 @@ augmented = [0,3,4,7,8,11]
augmented2 :: Fractional a => [a]
augmented2 = [0,1,4,5,8,9]
--- hexatonic modes with no tritone
+-- *** Hexatonic modes with no tritone
hexMajor7 :: Fractional a => [a]
hexMajor7 = [0,2,4,7,9,11]
hexDorian :: Fractional a => [a]
@@ -91,7 +95,7 @@ hexMajor6 = [0,2,4,5,7,9]
hexAeolian :: Fractional a => [a]
hexAeolian = [0,3,5,7,8,10]
--- 7 note scales
+-- ** 7 note scales
major :: Fractional a => [a]
major = [0,2,4,5,7,9,11]
ionian :: Fractional a => [a]
@@ -125,7 +129,7 @@ bartok = melodicMajor
hindu :: Fractional a => [a]
hindu = melodicMajor
--- raga modes
+-- *** Raga modes
todi :: Fractional a => [a]
todi = [0,1,3,6,7,8,11]
purvi :: Fractional a => [a]
@@ -137,7 +141,7 @@ bhairav = [0,1,4,5,7,8,11]
ahirbhairav :: Fractional a => [a]
ahirbhairav = [0,1,4,5,7,9,10]
---
+-- *** More modes
superLocrian :: Fractional a => [a]
superLocrian = [0,1,3,4,6,8,10]
romanianMinor :: Fractional a => [a]
@@ -151,7 +155,7 @@ enigmatic = [0,1,4,6,8,10,11]
spanish :: Fractional a => [a]
spanish = [0,1,4,5,7,8,10]
--- modes of whole tones with added note ->
+-- *** Modes of whole tones with added note ->
leadingWhole :: Fractional a => [a]
leadingWhole = [0,2,4,6,8,10,11]
lydianMinor :: Fractional a => [a]
@@ -161,13 +165,13 @@ neapolitanMajor = [0,1,3,5,7,9,11]
locrianMajor :: Fractional a => [a]
locrianMajor = [0,2,4,5,6,8,10]
--- 8 note scales
+-- ** 8 note scales
diminished :: Fractional a => [a]
diminished = [0,1,3,4,6,7,9,10]
diminished2 :: Fractional a => [a]
diminished2 = [0,2,3,5,6,8,9,11]
--- modes of limited transposition
+-- ** Modes of limited transposition
messiaen1 :: Fractional a => [a]
messiaen1 = whole'
messiaen2 :: Fractional a => [a]
@@ -183,7 +187,7 @@ messiaen6 = [0, 2, 4, 5, 6, 8, 10, 11]
messiaen7 :: Fractional a => [a]
messiaen7 = [0, 1, 2, 3, 5, 6, 7, 8, 9, 11]
--- Arabic maqams taken from SuperCollider's Scale.sc
+-- ** Arabic maqams taken from SuperCollider's Scale.sc
bayati :: Fractional a => [a]
bayati = [0, 1.5, 3, 5, 7, 8, 10]
hijaz :: Fractional a => [a]
@@ -197,22 +201,81 @@ iraq = [0, 1.5, 3.5, 5, 6.5, 8.5, 10.5]
saba :: Fractional a => [a]
saba = [0, 1.5, 3, 4, 6, 8, 10]
--- 12 note scales
+-- ** 12 note scales
chromatic :: Fractional a => [a]
chromatic = [0,1,2,3,4,5,6,7,8,9,10,11]
+{-|
+ Interprets a pattern of note numbers into a particular named scale. For example:
+
+ > d1
+ > $ jux rev
+ > $ chunk 4 (fast 2 . (|- n 12))
+ > $ off 0.25 (|+ 7)
+ > $ struct (iter 4 "t(5,8)")
+ > $ n (scale "ritusen" "0 .. 7")
+ > # sound "superpiano"
+-}
scale :: Fractional a => Pattern String -> Pattern Int -> Pattern a
scale = getScale scaleTable
+{-|
+ Build a scale function, with additional scales if you wish. For example:
+
+ > let myscale =
+ > getScale
+ > ( scaleTable ++
+ > [ ("techno", [0,2,3,5,7,8,10])
+ > , ("broken", [0,1,4,7,8,10])
+ > ]
+ > )
+
+ The above takes the standard 'scaleTable' as a starting point and adds two custom scales to it. You’ll be able to use the new function in place of the normal one:
+
+ > d1 $ n (myscale "techno" "0 1 2 3 4 5 6 7") # sound "superpiano"
+-}
getScale :: Fractional a => [(String, [a])] -> Pattern String -> Pattern Int -> Pattern a
getScale table sp p = (\n scaleName
-> noteInScale (fromMaybe [0] $ lookup scaleName table) n) <$> p <* sp
where octave s x = x `div` length s
noteInScale s x = (s !!! x) + fromIntegral (12 * octave s x)
+{-|
+ Outputs this list of all the available scales:
+
+@
+minPent majPent ritusen egyptian kumai hirajoshi iwato chinese indian pelog
+prometheus scriabin gong shang jiao zhi yu whole wholetone augmented augmented2
+hexMajor7 hexDorian hexPhrygian hexSus hexMajor6 hexAeolian major ionian dorian
+phrygian lydian mixolydian aeolian minor locrian harmonicMinor harmonicMajor
+melodicMinor melodicMinorDesc melodicMajor bartok hindu todi purvi marva bhairav
+ahirbhairav superLocrian romanianMinor hungarianMinor neapolitanMinor enigmatic
+spanish leadingWhole lydianMinor neapolitanMajor locrianMajor diminished
+octatonic diminished2 octatonic2 messiaen1 messiaen2 messiaen3 messiaen4
+messiaen5 messiaen6 messiaen7 chromatic bayati hijaz sikah rast saba iraq
+@
+-}
scaleList :: String
scaleList = unwords $ map fst (scaleTable :: [(String, [Rational])])
+{-|
+ Outputs a list of all available scales and their corresponding notes. For
+ example, its first entry is @("minPent",[0,3,5,7,10]@) which means that
+ a minor pentatonic scale is formed by the root (0), the minor third (3 semitones
+ above the root), the perfect fourth (5 semitones above the root), etc.
+
+ As the list is big, you can use the Haskell function lookup to look up a
+ specific scale: @lookup "phrygian" scaleTable@. This will output
+ @Just [0.0,1.0,3.0,5.0,7.0,8.0,10.0]@.
+
+ You can also do a reverse lookup into the scale table. For example:
+
+ > filter ( \(_, x) -> take 3 x == [0,2,4] ) scaleTable
+
+ The above example will output all scales of which the first three notes are
+ the root, the major second (2 semitones above the fundamental), and the major
+ third (4 semitones above the root).
+-}
scaleTable :: Fractional a => [(String, [a])]
scaleTable = [("minPent", minPent),
("majPent", majPent),
diff --git a/src/Sound/Tidal/Stream.hs b/src/Sound/Tidal/Stream.hs
index ebe81ba37..318951cf0 100644
--- a/src/Sound/Tidal/Stream.hs
+++ b/src/Sound/Tidal/Stream.hs
@@ -1,11 +1,23 @@
-{-# LANGUAGE ConstraintKinds, GeneralizedNewtypeDeriving, FlexibleContexts, ScopedTypeVariables, BangPatterns #-}
-{-# OPTIONS_GHC -fno-warn-missing-fields #-}
-{-# language DeriveGeneric, StandaloneDeriving #-}
-
-module Sound.Tidal.Stream (module Sound.Tidal.Stream) where
+module Sound.Tidal.Stream
+ (module Sound.Tidal.Stream.Config
+ ,module Sound.Tidal.Stream.Types
+ ,module Sound.Tidal.Stream.Process
+ ,module Sound.Tidal.Stream.Target
+ ,module Sound.Tidal.Stream.UI
+ ,module Sound.Tidal.Stream.Listen
+ ,module Sound.Tidal.Stream.Main
+ ) where
+
+import Sound.Tidal.Stream.Config
+import Sound.Tidal.Stream.Types
+import Sound.Tidal.Stream.Process
+import Sound.Tidal.Stream.Target
+import Sound.Tidal.Stream.UI
+import Sound.Tidal.Stream.Listen
+import Sound.Tidal.Stream.Main
{-
- Stream.hs - Tidal's thingie for turning patterns into OSC streams
+ Stream.hs - re-exports of all stream modules
Copyright (C) 2020, Alex McLean and contributors
This library is free software: you can redistribute it and/or modify
@@ -21,745 +33,3 @@ module Sound.Tidal.Stream (module Sound.Tidal.Stream) where
You should have received a copy of the GNU General Public License
along with this library. If not, see .
-}
-
-import Control.Applicative ((<|>))
-import Control.Concurrent.MVar
-import Control.Concurrent
-import Control.Monad (forM_, when)
-import Data.Coerce (coerce)
-import qualified Data.Map.Strict as Map
-import Data.Maybe (fromJust, fromMaybe, catMaybes, isJust)
-import qualified Control.Exception as E
-import Foreign
-import Foreign.C.Types
-import System.IO (hPutStrLn, stderr)
-
-import qualified Sound.Osc.Fd as O
-import qualified Sound.Osc.Time.Timeout as O
-import qualified Network.Socket as N
-
-import Sound.Tidal.Config
-import Sound.Tidal.Core (stack, (#))
-import Sound.Tidal.ID
-import qualified Sound.Tidal.Link as Link
-import Sound.Tidal.Params (pS)
-import Sound.Tidal.Pattern
-import qualified Sound.Tidal.Tempo as T
-import Sound.Tidal.Utils ((!!!))
-import Data.List (sortOn)
-import System.Random (getStdRandom, randomR)
-import Sound.Tidal.Show ()
-
-import Sound.Tidal.Version
-
-import Sound.Tidal.StreamTypes as Sound.Tidal.Stream
-
-data Stream = Stream {sConfig :: Config,
- sStateMV :: MVar ValueMap,
- -- sOutput :: MVar ControlPattern,
- sLink :: Link.AbletonLink,
- sListen :: Maybe O.Udp,
- sPMapMV :: MVar PlayMap,
- sActionsMV :: MVar [T.TempoAction],
- sGlobalFMV :: MVar (ControlPattern -> ControlPattern),
- sCxs :: [Cx]
- }
-
-data Cx = Cx {cxTarget :: Target,
- cxUDP :: O.Udp,
- cxOSCs :: [OSC],
- cxAddr :: N.AddrInfo,
- cxBusAddr :: Maybe N.AddrInfo,
- cxBusses :: Maybe (MVar [Int])
- }
-
-data StampStyle = BundleStamp
- | MessageStamp
- deriving (Eq, Show)
-
-data Schedule = Pre StampStyle
- | Live
- deriving (Eq, Show)
-
-data Target = Target {oName :: String,
- oAddress :: String,
- oPort :: Int,
- oBusPort :: Maybe Int,
- oLatency :: Double,
- oWindow :: Maybe Arc,
- oSchedule :: Schedule,
- oHandshake :: Bool
- }
- deriving Show
-
-data Args = Named {requiredArgs :: [String]}
- | ArgList [(String, Maybe Value)]
- deriving Show
-
-data OSC = OSC {path :: String,
- args :: Args
- }
- | OSCContext {path :: String}
- deriving Show
-
-data ProcessedEvent =
- ProcessedEvent {
- peHasOnset :: Bool,
- peEvent :: Event ValueMap,
- peCps :: Link.BPM,
- peDelta :: Link.Micros,
- peCycle :: Time,
- peOnWholeOrPart :: Link.Micros,
- peOnWholeOrPartOsc :: O.Time,
- peOnPart :: Link.Micros,
- peOnPartOsc :: O.Time
- }
-
-sDefault :: String -> Maybe Value
-sDefault x = Just $ VS x
-fDefault :: Double -> Maybe Value
-fDefault x = Just $ VF x
-rDefault :: Rational -> Maybe Value
-rDefault x = Just $ VR x
-iDefault :: Int -> Maybe Value
-iDefault x = Just $ VI x
-bDefault :: Bool -> Maybe Value
-bDefault x = Just $ VB x
-xDefault :: [Word8] -> Maybe Value
-xDefault x = Just $ VX x
-
-required :: Maybe Value
-required = Nothing
-
-superdirtTarget :: Target
-superdirtTarget = Target {oName = "SuperDirt",
- oAddress = "127.0.0.1",
- oPort = 57120,
- oBusPort = Just 57110,
- oLatency = 0.2,
- oWindow = Nothing,
- oSchedule = Pre BundleStamp,
- oHandshake = True
- }
-
-superdirtShape :: OSC
-superdirtShape = OSC "/dirt/play" $ Named {requiredArgs = ["s"]}
-
-dirtTarget :: Target
-dirtTarget = Target {oName = "Dirt",
- oAddress = "127.0.0.1",
- oPort = 7771,
- oBusPort = Nothing,
- oLatency = 0.02,
- oWindow = Nothing,
- oSchedule = Pre MessageStamp,
- oHandshake = False
- }
-
-dirtShape :: OSC
-dirtShape = OSC "/play" $ ArgList [("cps", fDefault 0),
- ("s", required),
- ("offset", fDefault 0),
- ("begin", fDefault 0),
- ("end", fDefault 1),
- ("speed", fDefault 1),
- ("pan", fDefault 0.5),
- ("velocity", fDefault 0.5),
- ("vowel", sDefault ""),
- ("cutoff", fDefault 0),
- ("resonance", fDefault 0),
- ("accelerate", fDefault 0),
- ("shape", fDefault 0),
- ("kriole", iDefault 0),
- ("gain", fDefault 1),
- ("cut", iDefault 0),
- ("delay", fDefault 0),
- ("delaytime", fDefault (-1)),
- ("delayfeedback", fDefault (-1)),
- ("crush", fDefault 0),
- ("coarse", iDefault 0),
- ("hcutoff", fDefault 0),
- ("hresonance", fDefault 0),
- ("bandf", fDefault 0),
- ("bandq", fDefault 0),
- ("unit", sDefault "rate"),
- ("loop", fDefault 0),
- ("n", fDefault 0),
- ("attack", fDefault (-1)),
- ("hold", fDefault 0),
- ("release", fDefault (-1)),
- ("orbit", iDefault 0) -- ,
- -- ("id", iDefault 0)
- ]
-
-defaultCps :: O.Time
-defaultCps = 0.5625
-
--- Start an instance of Tidal
--- Spawns a thread within Tempo that acts as the clock
--- Spawns a thread that listens to and acts on OSC control messages
-startStream :: Config -> [(Target, [OSC])] -> IO Stream
-startStream config oscmap
- = do sMapMV <- newMVar Map.empty
- pMapMV <- newMVar Map.empty
- globalFMV <- newMVar id
- actionsMV <- newEmptyMVar
-
- tidal_status_string >>= verbose config
- verbose config $ "Listening for external controls on " ++ cCtrlAddr config ++ ":" ++ show (cCtrlPort config)
- listen <- openListener config
-
- cxs <- mapM (\(target, os) -> do remote_addr <- resolve (oAddress target) (oPort target)
- remote_bus_addr <- sequence (resolve (oAddress target) <$> (oBusPort target))
- remote_busses <- sequence (oBusPort target >> (Just $ newMVar []))
- let broadcast = if cCtrlBroadcast config then 1 else 0
- u <- O.udp_socket (\sock sockaddr -> do N.setSocketOption sock N.Broadcast broadcast
- -- N.connect sock sockaddr
- ) (oAddress target) (oPort target)
- let cx = Cx {cxUDP = u, cxAddr = remote_addr, cxBusAddr = remote_bus_addr, cxBusses = remote_busses, cxTarget = target, cxOSCs = os}
- _ <- forkIO $ handshake cx config
- return cx
- ) oscmap
- let bpm = (coerce defaultCps) * 60 * (cBeatsPerCycle config)
- abletonLink <- Link.create bpm
- let stream = Stream {sConfig = config,
- sStateMV = sMapMV,
- sLink = abletonLink,
- sListen = listen,
- sPMapMV = pMapMV,
- sActionsMV = actionsMV,
- sGlobalFMV = globalFMV,
- sCxs = cxs
- }
- let ac = T.ActionHandler {
- T.onTick = onTick stream,
- T.onSingleTick = onSingleTick stream,
- T.updatePattern = updatePattern stream
- }
- -- Spawn a thread that acts as the clock
- _ <- T.clocked config sMapMV pMapMV actionsMV ac abletonLink
- -- Spawn a thread to handle OSC control messages
- _ <- forkIO $ ctrlResponder config stream
- return stream
-
-handshake :: Cx -> Config -> IO ()
-handshake Cx { cxUDP = udp, cxBusses = Just bussesMV, cxAddr = addr } c = sendHandshake >> listen 0
- where
- sendHandshake :: IO ()
- sendHandshake = O.sendTo udp (O.Packet_Message $ O.Message "/dirt/handshake" []) (N.addrAddress addr)
- listen :: Int -> IO ()
- listen waits = do ms <- recvMessagesTimeout 2 udp
- if (null ms)
- then do checkHandshake waits -- there was a timeout, check handshake
- listen (waits+1)
- else do mapM_ respond ms
- listen 0
- checkHandshake :: Int -> IO ()
- checkHandshake waits = do busses <- readMVar bussesMV
- when (null busses) $ do when (waits == 0) $ verbose c $ "Waiting for SuperDirt (v.1.7.2 or higher).."
- sendHandshake
- respond :: O.Message -> IO ()
- respond (O.Message "/dirt/hello" _) = sendHandshake
- respond (O.Message "/dirt/handshake/reply" xs) = do prev <- swapMVar bussesMV $ bufferIndices xs
- -- Only report the first time..
- when (null prev) $ verbose c $ "Connected to SuperDirt."
- return ()
- respond _ = return ()
- bufferIndices :: [O.Datum] -> [Int]
- bufferIndices [] = []
- bufferIndices (x:xs') | x == (O.AsciiString $ O.ascii "&controlBusIndices") = catMaybes $ takeWhile isJust $ map O.datum_integral xs'
- | otherwise = bufferIndices xs'
-handshake _ _ = return ()
-
-sendO :: Bool -> Cx -> O.Message -> IO ()
-sendO isBusMsg cx msg = O.sendTo (cxUDP cx) (O.Packet_Message msg) (N.addrAddress addr)
- where addr | isBusMsg && isJust (cxBusAddr cx) = fromJust $ cxBusAddr cx
- | otherwise = cxAddr cx
-
-sendBndl :: Bool -> Cx -> O.Bundle -> IO ()
-sendBndl isBusMsg cx bndl = O.sendTo (cxUDP cx) (O.Packet_Bundle bndl) (N.addrAddress addr)
- where addr | isBusMsg && isJust (cxBusAddr cx) = fromJust $ cxBusAddr cx
- | otherwise = cxAddr cx
-
-resolve :: String -> Int -> IO N.AddrInfo
-resolve host port = do let hints = N.defaultHints { N.addrSocketType = N.Stream }
- addr:_ <- N.getAddrInfo (Just hints) (Just host) (Just $ show port)
- return addr
-
--- Start an instance of Tidal with superdirt OSC
-startTidal :: Target -> Config -> IO Stream
-startTidal target config = startStream config [(target, [superdirtShape])]
-
-startMulti :: [Target] -> Config -> IO ()
-startMulti _ _ = hPutStrLn stderr $ "startMulti has been removed, please check the latest documentation on tidalcycles.org"
-
-toDatum :: Value -> O.Datum
-toDatum (VF x) = O.float x
-toDatum (VN x) = O.float x
-toDatum (VI x) = O.int32 x
-toDatum (VS x) = O.string x
-toDatum (VR x) = O.float $ ((fromRational x) :: Double)
-toDatum (VB True) = O.int32 (1 :: Int)
-toDatum (VB False) = O.int32 (0 :: Int)
-toDatum (VX xs) = O.Blob $ O.blob_pack xs
-toDatum _ = error "toDatum: unhandled value"
-
-toData :: OSC -> Event ValueMap -> Maybe [O.Datum]
-toData (OSC {args = ArgList as}) e = fmap (fmap (toDatum)) $ sequence $ map (\(n,v) -> Map.lookup n (value e) <|> v) as
-toData (OSC {args = Named rqrd}) e
- | hasRequired rqrd = Just $ concatMap (\(n,v) -> [O.string n, toDatum v]) $ Map.toList $ value e
- | otherwise = Nothing
- where hasRequired [] = True
- hasRequired xs = null $ filter (not . (`elem` ks)) xs
- ks = Map.keys (value e)
-toData _ _ = Nothing
-
-substitutePath :: String -> ValueMap -> Maybe String
-substitutePath str cm = parse str
- where parse [] = Just []
- parse ('{':xs) = parseWord xs
- parse (x:xs) = do xs' <- parse xs
- return (x:xs')
- parseWord xs | b == [] = getString cm a
- | otherwise = do v <- getString cm a
- xs' <- parse (tail b)
- return $ v ++ xs'
- where (a,b) = break (== '}') xs
-
-getString :: ValueMap -> String -> Maybe String
-getString cm s = (simpleShow <$> Map.lookup param cm) <|> defaultValue dflt
- where (param, dflt) = break (== '=') s
- simpleShow :: Value -> String
- simpleShow (VS str) = str
- simpleShow (VI i) = show i
- simpleShow (VF f) = show f
- simpleShow (VN n) = show n
- simpleShow (VR r) = show r
- simpleShow (VB b) = show b
- simpleShow (VX xs) = show xs
- simpleShow (VState _) = show ""
- simpleShow (VPattern _) = show ""
- simpleShow (VList _) = show ""
- defaultValue :: String -> Maybe String
- defaultValue ('=':dfltVal) = Just dfltVal
- defaultValue _ = Nothing
-
-playStack :: PlayMap -> ControlPattern
-playStack pMap = stack . (map pattern) . (filter active) . Map.elems $ pMap
- where active pState = if hasSolo pMap
- then solo pState
- else not (mute pState)
-
-toOSC :: Maybe [Int] -> ProcessedEvent -> OSC -> [(Double, Bool, O.Message)]
-toOSC maybeBusses pe osc@(OSC _ _)
- = catMaybes (playmsg:busmsgs)
- -- playmap is a ValueMap where the keys don't start with ^ and are not ""
- -- busmap is a ValueMap containing the rest of the keys from the event value
- -- The partition is performed in order to have special handling of bus ids.
- where
- (playmap, busmap) = Map.partitionWithKey (\k _ -> null k || head k /= '^') $ val pe
- -- Map in bus ids where needed.
- --
- -- Bus ids are integers
- -- If busses is empty, the ids to send are directly contained in the the values of the busmap.
- -- Otherwise, the ids to send are contained in busses at the indices of the values of the busmap.
- -- Both cases require that the values of the busmap are only ever integers,
- -- that is, they are Values with constructor VI
- -- (but perhaps we should explicitly crash with an error message if it contains something else?).
- -- Map.mapKeys tail is used to remove ^ from the keys.
- -- In case (value e) has the key "", we will get a crash here.
- playmap' = Map.union (Map.mapKeys tail $ Map.map (\(VI i) -> VS ('c':(show $ toBus i))) busmap) playmap
- val = value . peEvent
- -- Only events that start within the current nowArc are included
- playmsg | peHasOnset pe = do
- -- If there is already cps in the event, the union will preserve that.
- let extra = Map.fromList [("cps", (VF (coerce $! peCps pe))),
- ("delta", VF (T.addMicrosToOsc (peDelta pe) 0)),
- ("cycle", VF (fromRational (peCycle pe)))
- ]
- addExtra = Map.union playmap' extra
- ts = (peOnWholeOrPartOsc pe) + nudge -- + latency
- vs <- toData osc ((peEvent pe) {value = addExtra})
- mungedPath <- substitutePath (path osc) playmap'
- return (ts,
- False, -- bus message ?
- O.Message mungedPath vs
- )
- | otherwise = Nothing
- toBus n | Just busses <- maybeBusses, (not . null) busses = busses !!! n
- | otherwise = n
- busmsgs = map
- (\(('^':k), (VI b)) -> do v <- Map.lookup k playmap
- return $ (tsPart,
- True, -- bus message ?
- O.Message "/c_set" [O.int32 b, toDatum v]
- )
- )
- (Map.toList busmap)
- where
- tsPart = (peOnPartOsc pe) + nudge -- + latency
- nudge = fromJust $ getF $ fromMaybe (VF 0) $ Map.lookup "nudge" $ playmap
-toOSC _ pe (OSCContext oscpath)
- = map cToM $ contextPosition $ context $ peEvent pe
- where cToM :: ((Int,Int),(Int,Int)) -> (Double, Bool, O.Message)
- cToM ((x, y), (x',y')) = (ts,
- False, -- bus message ?
- O.Message oscpath $ (O.string ident):(O.float (peDelta pe)):(O.float cyc):(map O.int32 [x,y,x',y'])
- )
- cyc :: Double
- cyc = fromRational $ peCycle pe
- nudge = fromMaybe 0 $ Map.lookup "nudge" (value $ peEvent pe) >>= getF
- ident = fromMaybe "unknown" $ Map.lookup "_id_" (value $ peEvent pe) >>= getS
- ts = (peOnWholeOrPartOsc pe) + nudge -- + latency
-
-
--- Used for Tempo callback
-updatePattern :: Stream -> ID -> Time -> ControlPattern -> IO ()
-updatePattern stream k !t pat = do
- let x = queryArc pat (Arc 0 0)
- pMap <- seq x $ takeMVar (sPMapMV stream)
- let playState = updatePS $ Map.lookup (fromID k) pMap
- putMVar (sPMapMV stream) $ Map.insert (fromID k) playState pMap
- where updatePS (Just playState) = do playState {pattern = pat', history = pat:(history playState)}
- updatePS Nothing = PlayState pat' False False [pat']
- patControls = Map.singleton patternTimeID (VR t)
- pat' = withQueryControls (Map.union patControls)
- $ pat # pS "_id_" (pure $ fromID k)
-
-processCps :: T.LinkOperations -> [Event ValueMap] -> IO [ProcessedEvent]
-processCps ops = mapM processEvent
- where
- processEvent :: Event ValueMap -> IO ProcessedEvent
- processEvent e = do
- let wope = wholeOrPart e
- partStartCycle = start $ part e
- partStartBeat = (T.cyclesToBeat ops) (realToFrac partStartCycle)
- onCycle = start wope
- onBeat = (T.cyclesToBeat ops) (realToFrac onCycle)
- offCycle = stop wope
- offBeat = (T.cyclesToBeat ops) (realToFrac offCycle)
- on <- (T.timeAtBeat ops) onBeat
- onPart <- (T.timeAtBeat ops) partStartBeat
- when (eventHasOnset e) (do
- let cps' = Map.lookup "cps" (value e) >>= getF
- maybe (return ()) (\newCps -> (T.setTempo ops) ((T.cyclesToBeat ops) (newCps * 60)) on) $ coerce cps'
- )
- off <- (T.timeAtBeat ops) offBeat
- bpm <- (T.getTempo ops)
- let cps = ((T.beatToCycles ops) bpm) / 60
- let delta = off - on
- return $! ProcessedEvent {
- peHasOnset = eventHasOnset e,
- peEvent = e,
- peCps = cps,
- peDelta = delta,
- peCycle = onCycle,
- peOnWholeOrPart = on,
- peOnWholeOrPartOsc = (T.linkToOscTime ops) on,
- peOnPart = onPart,
- peOnPartOsc = (T.linkToOscTime ops) onPart
- }
-
-
--- streamFirst but with random cycle instead of always first cicle
-streamOnce :: Stream -> ControlPattern -> IO ()
-streamOnce st p = do i <- getStdRandom $ randomR (0, 8192)
- streamFirst st $ rotL (toRational (i :: Int)) p
-
--- here let's do modifyMVar_ on actions
-streamFirst :: Stream -> ControlPattern -> IO ()
-streamFirst stream pat = modifyMVar_ (sActionsMV stream) (\actions -> return $ (T.SingleTick pat) : actions)
-
--- Used for Tempo callback
-onTick :: Stream -> TickState -> T.LinkOperations -> ValueMap -> IO ValueMap
-onTick stream st ops s
- = doTick stream st ops s
-
--- Used for Tempo callback
--- Tempo changes will be applied.
--- However, since the full arc is processed at once and since Link does not support
--- scheduling, tempo change may affect scheduling of events that happen earlier
--- in the normal stream (the one handled by onTick).
-onSingleTick :: Stream -> T.LinkOperations -> ValueMap -> ControlPattern -> IO ValueMap
-onSingleTick stream ops s pat = do
- pMapMV <- newMVar $ Map.singleton "fake"
- (PlayState {pattern = pat,
- mute = False,
- solo = False,
- history = []
- }
- )
-
- -- The nowArc is a full cycle
- let state = TickState {tickArc = (Arc 0 1), tickNudge = 0}
- doTick (stream {sPMapMV = pMapMV}) state ops s
-
-
--- | Query the current pattern (contained in argument @stream :: Stream@)
--- for the events in the current arc (contained in argument @st :: T.State@),
--- translate them to OSC messages, and send these.
---
--- If an exception occurs during sending,
--- this functions prints a warning and continues, because
--- the likely reason is that the backend (supercollider) isn't running.
---
--- If any exception occurs before or outside sending
--- (e.g., while querying the pattern, while computing a message),
--- this function prints a warning and resets the current pattern
--- to the previous one (or to silence if there isn't one) and continues,
--- because the likely reason is that something is wrong with the current pattern.
-doTick :: Stream -> TickState -> T.LinkOperations -> ValueMap -> IO ValueMap
-doTick stream st ops sMap =
- E.handle (\ (e :: E.SomeException) -> do
- hPutStrLn stderr $ "Failed to Stream.doTick: " ++ show e
- hPutStrLn stderr $ "Return to previous pattern."
- setPreviousPatternOrSilence stream
- return sMap) (do
- pMap <- readMVar (sPMapMV stream)
- sGlobalF <- readMVar (sGlobalFMV stream)
- bpm <- (T.getTempo ops)
- let
- cxs = sCxs stream
- patstack = sGlobalF $ playStack pMap
- cps = ((T.beatToCycles ops) bpm) / 60
- sMap' = Map.insert "_cps" (VF $ coerce cps) sMap
- extraLatency = tickNudge st
- -- First the state is used to query the pattern
- es = sortOn (start . part) $ query patstack (State {arc = tickArc st,
- controls = sMap'
- }
- )
- -- Then it's passed through the events
- (sMap'', es') = resolveState sMap' es
- tes <- processCps ops es'
- -- For each OSC target
- forM_ cxs $ \cx@(Cx target _ oscs _ _ bussesMV) -> do
- busses <- mapM readMVar bussesMV
- -- Latency is configurable per target.
- -- Latency is only used when sending events live.
- let latency = oLatency target
- ms = concatMap (\e -> concatMap (toOSC busses e) oscs) tes
- -- send the events to the OSC target
- forM_ ms $ \ m -> (do
- send cx latency extraLatency m) `E.catch` \ (e :: E.SomeException) -> do
- hPutStrLn stderr $ "Failed to send. Is the '" ++ oName target ++ "' target running? " ++ show e
- sMap'' `seq` return sMap'')
-
-setPreviousPatternOrSilence :: Stream -> IO ()
-setPreviousPatternOrSilence stream =
- modifyMVar_ (sPMapMV stream) $ return
- . Map.map ( \ pMap -> case history pMap of
- _:p:ps -> pMap { pattern = p, history = p:ps }
- _ -> pMap { pattern = silence, history = [silence] }
- )
-
--- send has three modes:
--- Send events early using timestamp in the OSC bundle - used by Superdirt
--- Send events early by adding timestamp to the OSC message - used by Dirt
--- Send events live by delaying the thread
-send :: Cx -> Double -> Double -> (Double, Bool, O.Message) -> IO ()
-send cx latency extraLatency (time, isBusMsg, m)
- | oSchedule target == Pre BundleStamp = sendBndl isBusMsg cx $ O.Bundle timeWithLatency [m]
- | oSchedule target == Pre MessageStamp = sendO isBusMsg cx $ addtime m
- | otherwise = do _ <- forkOS $ do now <- O.time
- threadDelay $ floor $ (timeWithLatency - now) * 1000000
- sendO isBusMsg cx m
- return ()
- where addtime (O.Message mpath params) = O.Message mpath ((O.int32 sec):((O.int32 usec):params))
- ut = O.ntpr_to_posix timeWithLatency
- sec :: Int
- sec = floor ut
- usec :: Int
- usec = floor $ 1000000 * (ut - (fromIntegral sec))
- target = cxTarget cx
- timeWithLatency = time - latency + extraLatency
-
--- Interaction
-
-streamNudgeAll :: Stream -> Double -> IO ()
-streamNudgeAll s nudge = T.setNudge (sActionsMV s) nudge
-
-streamResetCycles :: Stream -> IO ()
-streamResetCycles s = streamSetCycle s 0
-
-streamSetCycle :: Stream -> Time -> IO ()
-streamSetCycle s cyc = T.setCycle cyc (sActionsMV s)
-
-hasSolo :: Map.Map k PlayState -> Bool
-hasSolo = (>= 1) . length . filter solo . Map.elems
-
-streamList :: Stream -> IO ()
-streamList s = do pMap <- readMVar (sPMapMV s)
- let hs = hasSolo pMap
- putStrLn $ concatMap (showKV hs) $ Map.toList pMap
- where showKV :: Bool -> (PatId, PlayState) -> String
- showKV True (k, (PlayState {solo = True})) = k ++ " - solo\n"
- showKV True (k, _) = "(" ++ k ++ ")\n"
- showKV False (k, (PlayState {solo = False})) = k ++ "\n"
- showKV False (k, _) = "(" ++ k ++ ") - muted\n"
-
--- Evaluation of pat is forced so exceptions are picked up here, before replacing the existing pattern.
-
-streamReplace :: Stream -> ID -> ControlPattern -> IO ()
-streamReplace s k !pat
- = modifyMVar_ (sActionsMV s) (\actions -> return $ (T.StreamReplace k pat) : actions)
-
-streamMute :: Stream -> ID -> IO ()
-streamMute s k = withPatIds s [k] (\x -> x {mute = True})
-
-streamMutes :: Stream -> [ID] -> IO ()
-streamMutes s ks = withPatIds s ks (\x -> x {mute = True})
-
-streamUnmute :: Stream -> ID -> IO ()
-streamUnmute s k = withPatIds s [k] (\x -> x {mute = False})
-
-streamSolo :: Stream -> ID -> IO ()
-streamSolo s k = withPatIds s [k] (\x -> x {solo = True})
-
-streamUnsolo :: Stream -> ID -> IO ()
-streamUnsolo s k = withPatIds s [k] (\x -> x {solo = False})
-
-withPatIds :: Stream -> [ID] -> (PlayState -> PlayState) -> IO ()
-withPatIds s ks f
- = do playMap <- takeMVar $ sPMapMV s
- let pMap' = foldr (Map.update (\x -> Just $ f x)) playMap (map fromID ks)
- putMVar (sPMapMV s) pMap'
- return ()
-
--- TODO - is there a race condition here?
-streamMuteAll :: Stream -> IO ()
-streamMuteAll s = modifyMVar_ (sPMapMV s) $ return . fmap (\x -> x {mute = True})
-
-streamHush :: Stream -> IO ()
-streamHush s = modifyMVar_ (sPMapMV s) $ return . fmap (\x -> x {pattern = silence, history = silence:history x})
-
-streamUnmuteAll :: Stream -> IO ()
-streamUnmuteAll s = modifyMVar_ (sPMapMV s) $ return . fmap (\x -> x {mute = False})
-
-streamUnsoloAll :: Stream -> IO ()
-streamUnsoloAll s = modifyMVar_ (sPMapMV s) $ return . fmap (\x -> x {solo = False})
-
-streamSilence :: Stream -> ID -> IO ()
-streamSilence s k = withPatIds s [k] (\x -> x {pattern = silence, history = silence:history x})
-
-streamAll :: Stream -> (ControlPattern -> ControlPattern) -> IO ()
-streamAll s f = do _ <- swapMVar (sGlobalFMV s) f
- return ()
-
-streamGet :: Stream -> String -> IO (Maybe Value)
-streamGet s k = Map.lookup k <$> readMVar (sStateMV s)
-
-streamSet :: Valuable a => Stream -> String -> Pattern a -> IO ()
-streamSet s k pat = do sMap <- takeMVar $ sStateMV s
- let pat' = toValue <$> pat
- sMap' = Map.insert k (VPattern pat') sMap
- putMVar (sStateMV s) $ sMap'
-
-streamSetI :: Stream -> String -> Pattern Int -> IO ()
-streamSetI = streamSet
-
-streamSetF :: Stream -> String -> Pattern Double -> IO ()
-streamSetF = streamSet
-
-streamSetS :: Stream -> String -> Pattern String -> IO ()
-streamSetS = streamSet
-
-streamSetB :: Stream -> String -> Pattern Bool -> IO ()
-streamSetB = streamSet
-
-streamSetR :: Stream -> String -> Pattern Rational -> IO ()
-streamSetR = streamSet
-
-openListener :: Config -> IO (Maybe O.Udp)
-openListener c
- | cCtrlListen c = catchAny run (\_ -> do verbose c "That port isn't available, perhaps another Tidal instance is already listening on that port?"
- return Nothing
- )
- | otherwise = return Nothing
- where
- run = do sock <- O.udpServer (cCtrlAddr c) (cCtrlPort c)
- when (cCtrlBroadcast c) $ N.setSocketOption (O.udpSocket sock) N.Broadcast 1
- return $ Just sock
- catchAny :: IO a -> (E.SomeException -> IO a) -> IO a
- catchAny = E.catch
-
--- Listen to and act on OSC control messages
-ctrlResponder :: Config -> Stream -> IO ()
-ctrlResponder c (stream@(Stream {sListen = Just sock})) = loop
- where
- loop :: IO ()
- loop = do O.recvMessages sock >>= mapM_ act
- loop
- -- External controller commands
- act :: O.Message -> IO ()
- act (O.Message "/ctrl" (O.Int32 k:v:[]))
- = act (O.Message "/ctrl" [O.string $ show k,v])
- act (O.Message "/ctrl" (O.AsciiString k:v@(O.Float _):[]))
- = add (O.ascii_to_string k) (VF (fromJust $ O.datum_floating v))
- act (O.Message "/ctrl" (O.AsciiString k:O.AsciiString v:[]))
- = add (O.ascii_to_string k) (VS (O.ascii_to_string v))
- act (O.Message "/ctrl" (O.AsciiString k:O.Int32 v:[]))
- = add (O.ascii_to_string k) (VI (fromIntegral v))
- -- Stream playback commands
- act (O.Message "/mute" (k:[]))
- = withID k $ streamMute stream
- act (O.Message "/unmute" (k:[]))
- = withID k $ streamUnmute stream
- act (O.Message "/solo" (k:[]))
- = withID k $ streamSolo stream
- act (O.Message "/unsolo" (k:[]))
- = withID k $ streamUnsolo stream
- act (O.Message "/muteAll" [])
- = streamMuteAll stream
- act (O.Message "/unmuteAll" [])
- = streamUnmuteAll stream
- act (O.Message "/unsoloAll" [])
- = streamUnsoloAll stream
- act (O.Message "/hush" [])
- = streamHush stream
- act (O.Message "/silence" (k:[]))
- = withID k $ streamSilence stream
- act m = hPutStrLn stderr $ "Unhandled OSC: " ++ show m
- add :: String -> Value -> IO ()
- add k v = do sMap <- takeMVar (sStateMV stream)
- putMVar (sStateMV stream) $ Map.insert k v sMap
- return ()
- withID :: O.Datum -> (ID -> IO ()) -> IO ()
- withID (O.AsciiString k) func = func $ (ID . O.ascii_to_string) k
- withID (O.Int32 k) func = func $ (ID . show) k
- withID _ _ = return ()
-ctrlResponder _ _ = return ()
-
-verbose :: Config -> String -> IO ()
-verbose c s = when (cVerbose c) $ putStrLn s
-
-recvMessagesTimeout :: (O.Transport t) => Double -> t -> IO [O.Message]
-recvMessagesTimeout n sock = fmap (maybe [] O.packetMessages) $ O.recvPacketTimeout n sock
-
-streamGetcps :: Stream -> IO Double
-streamGetcps s = do
- let config = sConfig s
- ss <- Link.createAndCaptureAppSessionState (sLink s)
- bpm <- Link.getTempo ss
- Link.destroySessionState ss
- return $! coerce $ bpm / (cBeatsPerCycle config) / 60
-
-streamGetnow :: Stream -> IO Double
-streamGetnow s = do
- let config = sConfig s
- ss <- Link.createAndCaptureAppSessionState (sLink s)
- now <- Link.clock (sLink s)
- beat <- Link.beatAtTime ss now (cQuantum config)
- Link.destroySessionState ss
- return $! coerce $ beat / (cBeatsPerCycle config)
-
-getProcessAhead :: Stream -> Link.Micros
-getProcessAhead str = round $ (cProcessAhead $ sConfig str) * 100000
-
-streamGetAhead :: Stream -> IO Double
-streamGetAhead str = do
- ss <- Link.createAndCaptureAppSessionState (sLink str)
- now <- Link.clock (sLink str)
- beat <- Link.beatAtTime ss (now + (getProcessAhead str)) (cQuantum $! sConfig str)
- Link.destroySessionState ss
- return $ coerce $! beat / (cBeatsPerCycle $! sConfig str)
diff --git a/src/Sound/Tidal/Config.hs b/src/Sound/Tidal/Stream/Config.hs
similarity index 58%
rename from src/Sound/Tidal/Config.hs
rename to src/Sound/Tidal/Stream/Config.hs
index 8e83853b4..295c41c46 100644
--- a/src/Sound/Tidal/Config.hs
+++ b/src/Sound/Tidal/Stream/Config.hs
@@ -1,7 +1,6 @@
-module Sound.Tidal.Config where
+module Sound.Tidal.Stream.Config where
-import Data.Int(Int64)
-import Foreign.C.Types (CDouble)
+import qualified Sound.Tidal.Clock as Clock
{-
Config.hs - For default Tidal configuration values.
@@ -25,16 +24,11 @@ data Config = Config {cCtrlListen :: Bool,
cCtrlAddr :: String,
cCtrlPort :: Int,
cCtrlBroadcast :: Bool,
- cFrameTimespan :: Double,
- cEnableLink :: Bool,
- cProcessAhead :: Double,
- cTempoAddr :: String,
- cTempoPort :: Int,
- cTempoClientPort :: Int,
- cSkipTicks :: Int64,
+ -- cTempoAddr :: String,
+ -- cTempoPort :: Int,
+ -- cTempoClientPort :: Int,
cVerbose :: Bool,
- cQuantum :: CDouble,
- cBeatsPerCycle :: CDouble
+ cClockConfig :: Clock.ClockConfig
}
defaultConfig :: Config
@@ -42,14 +36,9 @@ defaultConfig = Config {cCtrlListen = True,
cCtrlAddr ="127.0.0.1",
cCtrlPort = 6010,
cCtrlBroadcast = False,
- cFrameTimespan = 1/20,
- cEnableLink = True,
- cProcessAhead = 3/10,
- cTempoAddr = "127.0.0.1",
- cTempoPort = 9160,
- cTempoClientPort = 0, -- choose at random
- cSkipTicks = 10,
+ -- cTempoAddr = "127.0.0.1",
+ -- cTempoPort = 9160,
+ -- cTempoClientPort = 0, -- choose at random
cVerbose = True,
- cQuantum = 4,
- cBeatsPerCycle = 4
+ cClockConfig = Clock.defaultConfig
}
diff --git a/src/Sound/Tidal/Stream/Listen.hs b/src/Sound/Tidal/Stream/Listen.hs
new file mode 100644
index 000000000..8fa61cd47
--- /dev/null
+++ b/src/Sound/Tidal/Stream/Listen.hs
@@ -0,0 +1,118 @@
+module Sound.Tidal.Stream.Listen where
+
+import Data.Maybe (fromJust, catMaybes, isJust)
+import Control.Concurrent.MVar
+import Control.Monad (when)
+import System.IO (hPutStrLn, stderr)
+import qualified Data.Map as Map
+import qualified Sound.Osc.Fd as O
+import qualified Sound.Osc.Time.Timeout as O
+import qualified Network.Socket as N
+import qualified Control.Exception as E
+
+import Sound.Tidal.ID
+import Sound.Tidal.Pattern
+
+import Sound.Tidal.Stream.Config
+import Sound.Tidal.Stream.Types
+import Sound.Tidal.Stream.UI
+
+{-
+ Listen.hs - logic for listening and acting on incoming OSC messages
+ Copyright (C) 2020, Alex McLean and contributors
+
+ This library is free software: you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ This library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this library. If not, see .
+-}
+
+
+openListener :: Config -> IO (Maybe O.Udp)
+openListener c
+ | cCtrlListen c = catchAny run (\_ -> do verbose c "That port isn't available, perhaps another Tidal instance is already listening on that port?"
+ return Nothing
+ )
+ | otherwise = return Nothing
+ where
+ run = do sock <- O.udpServer (cCtrlAddr c) (cCtrlPort c)
+ when (cCtrlBroadcast c) $ N.setSocketOption (O.udpSocket sock) N.Broadcast 1
+ return $ Just sock
+ catchAny :: IO a -> (E.SomeException -> IO a) -> IO a
+ catchAny = E.catch
+
+-- Listen to and act on OSC control messages
+ctrlResponder :: Int -> Config -> Stream -> IO ()
+ctrlResponder waits c (stream@(Stream {sListen = Just sock}))
+ = do ms <- recvMessagesTimeout 2 sock
+ if (null ms)
+ then do checkHandshake -- there was a timeout, check handshake
+ ctrlResponder (waits+1) c stream
+ else do mapM_ act ms
+ ctrlResponder 0 c stream
+ where
+ checkHandshake = do busses <- readMVar (sBusses stream)
+ when (null busses) $ do when (waits == 0) $ verbose c $ "Waiting for SuperDirt (v.1.7.2 or higher).."
+ sendHandshakes stream
+
+ act (O.Message "/dirt/hello" _) = sendHandshakes stream
+ act (O.Message "/dirt/handshake/reply" xs) = do prev <- swapMVar (sBusses stream) $ bufferIndices xs
+ -- Only report the first time..
+ when (null prev) $ verbose c $ "Connected to SuperDirt."
+ return ()
+ where
+ bufferIndices [] = []
+ bufferIndices (x:xs') | x == (O.AsciiString $ O.ascii "&controlBusIndices") = catMaybes $ takeWhile isJust $ map O.datum_integral xs'
+ | otherwise = bufferIndices xs'
+ -- External controller commands
+ act (O.Message "/ctrl" (O.Int32 k:v:[]))
+ = act (O.Message "/ctrl" [O.string $ show k,v])
+ act (O.Message "/ctrl" (O.AsciiString k:v@(O.Float _):[]))
+ = add (O.ascii_to_string k) (VF (fromJust $ O.datum_floating v))
+ act (O.Message "/ctrl" (O.AsciiString k:O.AsciiString v:[]))
+ = add (O.ascii_to_string k) (VS (O.ascii_to_string v))
+ act (O.Message "/ctrl" (O.AsciiString k:O.Int32 v:[]))
+ = add (O.ascii_to_string k) (VI (fromIntegral v))
+ -- Stream playback commands
+ act (O.Message "/mute" (k:[]))
+ = withID k $ streamMute stream
+ act (O.Message "/unmute" (k:[]))
+ = withID k $ streamUnmute stream
+ act (O.Message "/solo" (k:[]))
+ = withID k $ streamSolo stream
+ act (O.Message "/unsolo" (k:[]))
+ = withID k $ streamUnsolo stream
+ act (O.Message "/muteAll" [])
+ = streamMuteAll stream
+ act (O.Message "/unmuteAll" [])
+ = streamUnmuteAll stream
+ act (O.Message "/unsoloAll" [])
+ = streamUnsoloAll stream
+ act (O.Message "/hush" [])
+ = streamHush stream
+ act (O.Message "/silence" (k:[]))
+ = withID k $ streamSilence stream
+ act m = hPutStrLn stderr $ "Unhandled OSC: " ++ show m
+ add :: String -> Value -> IO ()
+ add k v = do sMap <- takeMVar (sStateMV stream)
+ putMVar (sStateMV stream) $ Map.insert k v sMap
+ return ()
+ withID :: O.Datum -> (ID -> IO ()) -> IO ()
+ withID (O.AsciiString k) func = func $ (ID . O.ascii_to_string) k
+ withID (O.Int32 k) func = func $ (ID . show) k
+ withID _ _ = return ()
+ctrlResponder _ _ _ = return ()
+
+verbose :: Config -> String -> IO ()
+verbose c s = when (cVerbose c) $ putStrLn s
+
+recvMessagesTimeout :: (O.Transport t) => Double -> t -> IO [O.Message]
+recvMessagesTimeout n sock = fmap (maybe [] O.packetMessages) $ O.recvPacketTimeout n sock
diff --git a/src/Sound/Tidal/Stream/Main.hs b/src/Sound/Tidal/Stream/Main.hs
new file mode 100644
index 000000000..e4dd41c09
--- /dev/null
+++ b/src/Sound/Tidal/Stream/Main.hs
@@ -0,0 +1,78 @@
+module Sound.Tidal.Stream.Main where
+
+import qualified Data.Map as Map
+import qualified Sound.Tidal.Clock as Clock
+import Control.Concurrent.MVar
+import Control.Concurrent
+import System.IO (hPutStrLn, stderr)
+
+
+import Sound.Tidal.Version (tidal_status_string)
+import Sound.Tidal.Stream.Config
+import Sound.Tidal.Stream.Types
+import Sound.Tidal.Stream.Listen
+import Sound.Tidal.Stream.Target
+import Sound.Tidal.Stream.Process
+import Sound.Tidal.Stream.UI
+
+{-
+ Main.hs - Start tidals stream, listen and act on incoming messages
+ Copyright (C) 2020, Alex McLean and contributors
+
+ This library is free software: you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ This library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this library. If not, see .
+-}
+
+
+-- Start an instance of Tidal with superdirt OSC
+startTidal :: Target -> Config -> IO Stream
+startTidal target config = startStream config [(target, [superdirtShape])]
+
+-- Start an instance of Tidal
+-- Spawns a thread within Tempo that acts as the clock
+-- Spawns a thread that listens to and acts on OSC control messages
+startStream :: Config -> [(Target, [OSC])] -> IO Stream
+startStream config oscmap = do
+ sMapMV <- newMVar Map.empty
+ pMapMV <- newMVar Map.empty
+ bussesMV <- newMVar []
+ globalFMV <- newMVar id
+
+ tidal_status_string >>= verbose config
+ verbose config $ "Listening for external controls on " ++ cCtrlAddr config ++ ":" ++ show (cCtrlPort config)
+ listen <- openListener config
+
+ cxs <- getCXs config oscmap
+
+ clockRef <- Clock.clocked (cClockConfig config) (doTick sMapMV bussesMV pMapMV globalFMV cxs listen)
+
+ let stream = Stream {sConfig = config,
+ sBusses = bussesMV,
+ sStateMV = sMapMV,
+ sClockRef = clockRef,
+ -- sLink = abletonLink,
+ sListen = listen,
+ sPMapMV = pMapMV,
+ -- sActionsMV = actionsMV,
+ sGlobalFMV = globalFMV,
+ sCxs = cxs
+ }
+
+ sendHandshakes stream
+
+ -- Spawn a thread to handle OSC control messages
+ _ <- forkIO $ ctrlResponder 0 config stream
+ return stream
+
+startMulti :: [Target] -> Config -> IO ()
+startMulti _ _ = hPutStrLn stderr $ "startMulti has been removed, please check the latest documentation on tidalcycles.org"
diff --git a/src/Sound/Tidal/Stream/Process.hs b/src/Sound/Tidal/Stream/Process.hs
new file mode 100644
index 000000000..cb661c3bb
--- /dev/null
+++ b/src/Sound/Tidal/Stream/Process.hs
@@ -0,0 +1,319 @@
+{-# LANGUAGE ConstraintKinds, GeneralizedNewtypeDeriving, FlexibleContexts, ScopedTypeVariables, BangPatterns #-}
+{-# OPTIONS_GHC -fno-warn-missing-fields #-}
+{-# language DeriveGeneric, StandaloneDeriving #-}
+
+module Sound.Tidal.Stream.Process where
+
+{-
+ Process.hs - Tidal's thingie for turning patterns into OSC streams
+ Copyright (C) 2020, Alex McLean and contributors
+
+ This library is free software: you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ This library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this library. If not, see .
+-}
+
+import Control.Applicative ((<|>))
+import Control.Concurrent.MVar
+import Control.Monad (forM_, when)
+import Data.Coerce (coerce)
+import qualified Data.Map.Strict as Map
+import Data.Maybe (fromJust, fromMaybe, catMaybes)
+import qualified Control.Exception as E
+import Foreign.C.Types
+import System.IO (hPutStrLn, stderr)
+
+import qualified Sound.Osc.Fd as O
+
+import Sound.Tidal.Stream.Config
+import Sound.Tidal.Core (stack, (#))
+import Sound.Tidal.ID
+import qualified Sound.Tidal.Link as Link
+import qualified Sound.Tidal.Clock as Clock
+import Sound.Tidal.Params (pS)
+import Sound.Tidal.Pattern
+import Sound.Tidal.Utils ((!!!))
+import Data.List (sortOn)
+import Sound.Tidal.Show ()
+
+import Sound.Tidal.Stream.Types
+import Sound.Tidal.Stream.Target
+
+data ProcessedEvent =
+ ProcessedEvent {
+ peHasOnset :: Bool,
+ peEvent :: Event ValueMap,
+ peCps :: Link.BPM,
+ peDelta :: Link.Micros,
+ peCycle :: Time,
+ peOnWholeOrPart :: Link.Micros,
+ peOnWholeOrPartOsc :: O.Time,
+ peOnPart :: Link.Micros,
+ peOnPartOsc :: O.Time
+ }
+
+-- | Query the current pattern (contained in argument @stream :: Stream@)
+-- for the events in the current arc (contained in argument @st :: T.State@),
+-- translate them to OSC messages, and send these.
+--
+-- If an exception occurs during sending,
+-- this functions prints a warning and continues, because
+-- the likely reason is that the backend (supercollider) isn't running.
+--
+-- If any exception occurs before or outside sending
+-- (e.g., while querying the pattern, while computing a message),
+-- this function prints a warning and resets the current pattern
+-- to the previous one (or to silence if there isn't one) and continues,
+-- because the likely reason is that something is wrong with the current pattern.
+
+doTick :: MVar ValueMap -- pattern state
+ -> MVar [Int] -- busses
+ -> MVar PlayMap -- currently playing
+ -> MVar (ControlPattern -> ControlPattern) -- current global fx
+ -> [Cx] -- target addresses
+ -> Maybe O.Udp -- network socket
+ -> (Time,Time) -- current arc
+ -> Double -- nudge
+ -> Clock.LinkOperations -- ableton link operations
+ -> IO ()
+doTick stateMV busMV playMV globalFMV cxs listen (st,end) nudge ops =
+ E.handle (\ (e :: E.SomeException) -> do
+ hPutStrLn stderr $ "Failed to Stream.doTick: " ++ show e
+ hPutStrLn stderr $ "Return to previous pattern."
+ setPreviousPatternOrSilence playMV) (do
+ sMap <- takeMVar stateMV
+ pMap <- readMVar playMV
+ busses <- readMVar busMV
+ sGlobalF <- readMVar globalFMV
+ bpm <- (Clock.getTempo ops)
+ let
+ patstack = sGlobalF $ playStack pMap
+ cps = ((Clock.beatToCycles ops) bpm) / 60
+ sMap' = Map.insert "_cps" (VF $ coerce cps) sMap
+ extraLatency = nudge
+ -- First the state is used to query the pattern
+ es = sortOn (start . part) $ query patstack (State {arc = Arc st end,
+ controls = sMap'
+ }
+ )
+ -- Then it's passed through the events
+ (sMap'', es') = resolveState sMap' es
+ tes <- processCps ops es'
+ -- For each OSC target
+ forM_ cxs $ \cx@(Cx target _ oscs _ _) -> do
+ -- Latency is configurable per target.
+ -- Latency is only used when sending events live.
+ let latency = oLatency target
+ ms = concatMap (\e -> concatMap (toOSC busses e) oscs) tes
+ -- send the events to the OSC target
+ forM_ ms $ \m -> (send listen cx latency extraLatency m) `E.catch` \(e :: E.SomeException) ->
+ hPutStrLn stderr $ "Failed to send. Is the '" ++ oName target ++ "' target running? " ++ show e
+ putMVar stateMV sMap'')
+
+processCps :: Clock.LinkOperations -> [Event ValueMap] -> IO [ProcessedEvent]
+processCps ops = mapM processEvent
+ where
+ processEvent :: Event ValueMap -> IO ProcessedEvent
+ processEvent e = do
+ let wope = wholeOrPart e
+ partStartCycle = start $ part e
+ partStartBeat = (Clock.cyclesToBeat ops) (realToFrac partStartCycle)
+ onCycle = start wope
+ onBeat = (Clock.cyclesToBeat ops) (realToFrac onCycle)
+ offCycle = stop wope
+ offBeat = (Clock.cyclesToBeat ops) (realToFrac offCycle)
+ on <- (Clock.timeAtBeat ops) onBeat
+ onPart <- (Clock.timeAtBeat ops) partStartBeat
+ when (eventHasOnset e) (do
+ let cps' = Map.lookup "cps" (value e) >>= getF
+ maybe (return ()) (\newCps -> (Clock.setTempo ops) ((Clock.cyclesToBeat ops) (newCps * 60)) on) $ coerce cps'
+ )
+ off <- (Clock.timeAtBeat ops) offBeat
+ bpm <- (Clock.getTempo ops)
+ let cps = ((Clock.beatToCycles ops) bpm) / 60
+ let delta = off - on
+ return $! ProcessedEvent {
+ peHasOnset = eventHasOnset e,
+ peEvent = e,
+ peCps = cps,
+ peDelta = delta,
+ peCycle = onCycle,
+ peOnWholeOrPart = on,
+ peOnWholeOrPartOsc = (Clock.linkToOscTime ops) on,
+ peOnPart = onPart,
+ peOnPartOsc = (Clock.linkToOscTime ops) onPart
+ }
+
+
+toOSC :: [Int] -> ProcessedEvent -> OSC -> [(Double, Bool, O.Message)]
+toOSC busses pe osc@(OSC _ _)
+ = catMaybes (playmsg:busmsgs)
+ -- playmap is a ValueMap where the keys don't start with ^ and are not ""
+ -- busmap is a ValueMap containing the rest of the keys from the event value
+ -- The partition is performed in order to have special handling of bus ids.
+ where
+ (playmap, busmap) = Map.partitionWithKey (\k _ -> null k || head k /= '^') $ val pe
+ -- Map in bus ids where needed.
+ --
+ -- Bus ids are integers
+ -- If busses is empty, the ids to send are directly contained in the the values of the busmap.
+ -- Otherwise, the ids to send are contained in busses at the indices of the values of the busmap.
+ -- Both cases require that the values of the busmap are only ever integers,
+ -- that is, they are Values with constructor VI
+ -- (but perhaps we should explicitly crash with an error message if it contains something else?).
+ -- Map.mapKeys tail is used to remove ^ from the keys.
+ -- In case (value e) has the key "", we will get a crash here.
+ playmap' = Map.union (Map.mapKeys tail $ Map.map (\(VI i) -> VS ('c':(show $ toBus i))) busmap) playmap
+ val = value . peEvent
+ -- Only events that start within the current nowArc are included
+ playmsg | peHasOnset pe = do
+ -- If there is already cps in the event, the union will preserve that.
+ let extra = Map.fromList [("cps", (VF (coerce $! peCps pe))),
+ ("delta", VF (Clock.addMicrosToOsc (peDelta pe) 0)),
+ ("cycle", VF (fromRational (peCycle pe)))
+ ]
+ addExtra = Map.union playmap' extra
+ ts = (peOnWholeOrPartOsc pe) + nudge -- + latency
+ vs <- toData osc ((peEvent pe) {value = addExtra})
+ mungedPath <- substitutePath (path osc) playmap'
+ return (ts,
+ False, -- bus message ?
+ O.Message mungedPath vs
+ )
+ | otherwise = Nothing
+ toBus n | null busses = n
+ | otherwise = busses !!! n
+ busmsgs = map
+ (\(('^':k), (VI b)) -> do v <- Map.lookup k playmap
+ return $ (tsPart,
+ True, -- bus message ?
+ O.Message "/c_set" [O.int32 b, toDatum v]
+ )
+ )
+ (Map.toList busmap)
+ where
+ tsPart = (peOnPartOsc pe) + nudge -- + latency
+ nudge = fromJust $ getF $ fromMaybe (VF 0) $ Map.lookup "nudge" $ playmap
+toOSC _ pe (OSCContext oscpath)
+ = map cToM $ contextPosition $ context $ peEvent pe
+ where cToM :: ((Int,Int),(Int,Int)) -> (Double, Bool, O.Message)
+ cToM ((x, y), (x',y')) = (ts,
+ False, -- bus message ?
+ O.Message oscpath $ (O.string ident):(O.float (peDelta pe)):(O.float cyc):(map O.int32 [x,y,x',y'])
+ )
+ cyc :: Double
+ cyc = fromRational $ peCycle pe
+ nudge = fromMaybe 0 $ Map.lookup "nudge" (value $ peEvent pe) >>= getF
+ ident = fromMaybe "unknown" $ Map.lookup "_id_" (value $ peEvent pe) >>= getS
+ ts = (peOnWholeOrPartOsc pe) + nudge -- + latency
+
+toData :: OSC -> Event ValueMap -> Maybe [O.Datum]
+toData (OSC {args = ArgList as}) e = fmap (fmap (toDatum)) $ sequence $ map (\(n,v) -> Map.lookup n (value e) <|> v) as
+toData (OSC {args = Named rqrd}) e
+ | hasRequired rqrd = Just $ concatMap (\(n,v) -> [O.string n, toDatum v]) $ Map.toList $ value e
+ | otherwise = Nothing
+ where hasRequired [] = True
+ hasRequired xs = null $ filter (not . (`elem` ks)) xs
+ ks = Map.keys (value e)
+toData _ _ = Nothing
+
+toDatum :: Value -> O.Datum
+toDatum (VF x) = O.float x
+toDatum (VN x) = O.float x
+toDatum (VI x) = O.int32 x
+toDatum (VS x) = O.string x
+toDatum (VR x) = O.float $ ((fromRational x) :: Double)
+toDatum (VB True) = O.int32 (1 :: Int)
+toDatum (VB False) = O.int32 (0 :: Int)
+toDatum (VX xs) = O.Blob $ O.blob_pack xs
+toDatum _ = error "toDatum: unhandled value"
+
+substitutePath :: String -> ValueMap -> Maybe String
+substitutePath str cm = parse str
+ where parse [] = Just []
+ parse ('{':xs) = parseWord xs
+ parse (x:xs) = do xs' <- parse xs
+ return (x:xs')
+ parseWord xs | b == [] = getString cm a
+ | otherwise = do v <- getString cm a
+ xs' <- parse (tail b)
+ return $ v ++ xs'
+ where (a,b) = break (== '}') xs
+
+getString :: ValueMap -> String -> Maybe String
+getString cm s = (simpleShow <$> Map.lookup param cm) <|> defaultValue dflt
+ where (param, dflt) = break (== '=') s
+ simpleShow :: Value -> String
+ simpleShow (VS str) = str
+ simpleShow (VI i) = show i
+ simpleShow (VF f) = show f
+ simpleShow (VN n) = show n
+ simpleShow (VR r) = show r
+ simpleShow (VB b) = show b
+ simpleShow (VX xs) = show xs
+ simpleShow (VState _) = show ""
+ simpleShow (VPattern _) = show ""
+ simpleShow (VList _) = show ""
+ defaultValue :: String -> Maybe String
+ defaultValue ('=':dfltVal) = Just dfltVal
+ defaultValue _ = Nothing
+
+playStack :: PlayMap -> ControlPattern
+playStack pMap = stack . (map pattern) . (filter active) . Map.elems $ pMap
+ where active pState = if hasSolo pMap
+ then solo pState
+ else not (mute pState)
+
+hasSolo :: Map.Map k PlayState -> Bool
+hasSolo = (>= 1) . length . filter solo . Map.elems
+
+
+-- Used for Tempo callback
+-- Tempo changes will be applied.
+-- However, since the full arc is processed at once and since Link does not support
+-- scheduling, tempo change may affect scheduling of events that happen earlier
+-- in the normal stream (the one handled by onTick).
+onSingleTick :: Config -> Clock.ClockRef -> MVar ValueMap -> MVar [Int] -> MVar PlayMap -> MVar (ControlPattern -> ControlPattern) -> [Cx] -> Maybe O.Udp -> ControlPattern -> IO ()
+onSingleTick config clockRef stateMV busMV _ globalFMV cxs listen pat = do
+ ops <- Clock.getZeroedLinkOperations (cClockConfig config) clockRef
+ pMapMV <- newMVar $ Map.singleton "fake"
+ (PlayState {pattern = pat,
+ mute = False,
+ solo = False,
+ history = []
+ }
+ )
+ -- The nowArc is a full cycle
+ doTick stateMV busMV pMapMV globalFMV cxs listen (0,1) 0 ops
+
+
+
+-- Used for Tempo callback
+updatePattern :: Stream -> ID -> Time -> ControlPattern -> IO ()
+updatePattern stream k !t pat = do
+ let x = queryArc pat (Arc 0 0)
+ pMap <- seq x $ takeMVar (sPMapMV stream)
+ let playState = updatePS $ Map.lookup (fromID k) pMap
+ putMVar (sPMapMV stream) $ Map.insert (fromID k) playState pMap
+ where updatePS (Just playState) = do playState {pattern = pat', history = pat:(history playState)}
+ updatePS Nothing = PlayState pat' False False [pat']
+ patControls = Map.singleton patternTimeID (VR t)
+ pat' = withQueryControls (Map.union patControls)
+ $ pat # pS "_id_" (pure $ fromID k)
+
+setPreviousPatternOrSilence :: MVar PlayMap -> IO ()
+setPreviousPatternOrSilence playMV =
+ modifyMVar_ playMV $ return
+ . Map.map ( \ pMap -> case history pMap of
+ _:p:ps -> pMap { pattern = p, history = p:ps }
+ _ -> pMap { pattern = silence, history = [silence] }
+ )
diff --git a/src/Sound/Tidal/Stream/Target.hs b/src/Sound/Tidal/Stream/Target.hs
new file mode 100644
index 000000000..964cb992f
--- /dev/null
+++ b/src/Sound/Tidal/Stream/Target.hs
@@ -0,0 +1,156 @@
+module Sound.Tidal.Stream.Target where
+
+import qualified Sound.Osc.Fd as O
+import qualified Network.Socket as N
+import Data.Maybe (fromJust, isJust)
+import Control.Concurrent (forkOS, threadDelay)
+import Foreign (Word8)
+
+import Sound.Tidal.Pattern
+import Sound.Tidal.Stream.Types
+import Sound.Tidal.Stream.Config
+
+{-
+ Target.hs - Create and send to OSC targets
+ Copyright (C) 2020, Alex McLean and contributors
+
+ This library is free software: you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ This library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this library. If not, see .
+-}
+
+
+getCXs :: Config -> [(Target, [OSC])] -> IO [Cx]
+getCXs config oscmap = mapM (\(target, os) -> do
+ remote_addr <- resolve (oAddress target) (show $ oPort target)
+ remote_bus_addr <- if isJust $ oBusPort target
+ then Just <$> resolve (oAddress target) (show $ fromJust $ oBusPort target)
+ else return Nothing
+ let broadcast = if cCtrlBroadcast config then 1 else 0
+ u <- O.udp_socket (\sock sockaddr -> do N.setSocketOption sock N.Broadcast broadcast
+ N.connect sock sockaddr
+ ) (oAddress target) (oPort target)
+ return $ Cx {cxUDP = u, cxAddr = remote_addr, cxBusAddr = remote_bus_addr, cxTarget = target, cxOSCs = os}
+ ) oscmap
+
+resolve :: String -> String -> IO N.AddrInfo
+resolve host port = do let hints = N.defaultHints { N.addrSocketType = N.Stream }
+ addr:_ <- N.getAddrInfo (Just hints) (Just host) (Just port)
+ return addr
+
+-- send has three modes:
+-- Send events early using timestamp in the OSC bundle - used by Superdirt
+-- Send events early by adding timestamp to the OSC message - used by Dirt
+-- Send events live by delaying the thread
+send :: Maybe O.Udp -> Cx -> Double -> Double -> (Double, Bool, O.Message) -> IO ()
+send listen cx latency extraLatency (time, isBusMsg, m)
+ | oSchedule target == Pre BundleStamp = sendBndl isBusMsg listen cx $ O.Bundle timeWithLatency [m]
+ | oSchedule target == Pre MessageStamp = sendO isBusMsg listen cx $ addtime m
+ | otherwise = do _ <- forkOS $ do now <- O.time
+ threadDelay $ floor $ (timeWithLatency - now) * 1000000
+ sendO isBusMsg listen cx m
+ return ()
+ where addtime (O.Message mpath params) = O.Message mpath ((O.int32 sec):((O.int32 usec):params))
+ ut = O.ntpr_to_posix timeWithLatency
+ sec :: Int
+ sec = floor ut
+ usec :: Int
+ usec = floor $ 1000000 * (ut - (fromIntegral sec))
+ target = cxTarget cx
+ timeWithLatency = time - latency + extraLatency
+
+sendBndl :: Bool -> (Maybe O.Udp) -> Cx -> O.Bundle -> IO ()
+sendBndl isBusMsg (Just listen) cx bndl = O.sendTo listen (O.Packet_Bundle bndl) (N.addrAddress addr)
+ where addr | isBusMsg && isJust (cxBusAddr cx) = fromJust $ cxBusAddr cx
+ | otherwise = cxAddr cx
+sendBndl _ Nothing cx bndl = O.sendBundle (cxUDP cx) bndl
+
+sendO :: Bool -> (Maybe O.Udp) -> Cx -> O.Message -> IO ()
+sendO isBusMsg (Just listen) cx msg = O.sendTo listen (O.Packet_Message msg) (N.addrAddress addr)
+ where addr | isBusMsg && isJust (cxBusAddr cx) = fromJust $ cxBusAddr cx
+ | otherwise = cxAddr cx
+sendO _ Nothing cx msg = O.sendMessage (cxUDP cx) msg
+
+
+superdirtTarget :: Target
+superdirtTarget = Target {oName = "SuperDirt",
+ oAddress = "127.0.0.1",
+ oPort = 57120,
+ oBusPort = Just 57110,
+ oLatency = 0.2,
+ oWindow = Nothing,
+ oSchedule = Pre BundleStamp,
+ oHandshake = True
+ }
+
+superdirtShape :: OSC
+superdirtShape = OSC "/dirt/play" $ Named {requiredArgs = ["s"]}
+
+dirtTarget :: Target
+dirtTarget = Target {oName = "Dirt",
+ oAddress = "127.0.0.1",
+ oPort = 7771,
+ oBusPort = Nothing,
+ oLatency = 0.02,
+ oWindow = Nothing,
+ oSchedule = Pre MessageStamp,
+ oHandshake = False
+ }
+
+dirtShape :: OSC
+dirtShape = OSC "/play" $ ArgList [("cps", fDefault 0),
+ ("s", Nothing),
+ ("offset", fDefault 0),
+ ("begin", fDefault 0),
+ ("end", fDefault 1),
+ ("speed", fDefault 1),
+ ("pan", fDefault 0.5),
+ ("velocity", fDefault 0.5),
+ ("vowel", sDefault ""),
+ ("cutoff", fDefault 0),
+ ("resonance", fDefault 0),
+ ("accelerate", fDefault 0),
+ ("shape", fDefault 0),
+ ("kriole", iDefault 0),
+ ("gain", fDefault 1),
+ ("cut", iDefault 0),
+ ("delay", fDefault 0),
+ ("delaytime", fDefault (-1)),
+ ("delayfeedback", fDefault (-1)),
+ ("crush", fDefault 0),
+ ("coarse", iDefault 0),
+ ("hcutoff", fDefault 0),
+ ("hresonance", fDefault 0),
+ ("bandf", fDefault 0),
+ ("bandq", fDefault 0),
+ ("unit", sDefault "rate"),
+ ("loop", fDefault 0),
+ ("n", fDefault 0),
+ ("attack", fDefault (-1)),
+ ("hold", fDefault 0),
+ ("release", fDefault (-1)),
+ ("orbit", iDefault 0) -- ,
+ -- ("id", iDefault 0)
+ ]
+
+sDefault :: String -> Maybe Value
+sDefault x = Just $ VS x
+fDefault :: Double -> Maybe Value
+fDefault x = Just $ VF x
+rDefault :: Rational -> Maybe Value
+rDefault x = Just $ VR x
+iDefault :: Int -> Maybe Value
+iDefault x = Just $ VI x
+bDefault :: Bool -> Maybe Value
+bDefault x = Just $ VB x
+xDefault :: [Word8] -> Maybe Value
+xDefault x = Just $ VX x
diff --git a/src/Sound/Tidal/Stream/Types.hs b/src/Sound/Tidal/Stream/Types.hs
new file mode 100644
index 000000000..f5589f353
--- /dev/null
+++ b/src/Sound/Tidal/Stream/Types.hs
@@ -0,0 +1,79 @@
+module Sound.Tidal.Stream.Types where
+
+import Control.Concurrent.MVar
+import qualified Data.Map.Strict as Map
+import Sound.Tidal.Pattern
+import Sound.Tidal.Show ()
+
+import qualified Sound.Osc.Fd as O
+import qualified Network.Socket as N
+
+import qualified Sound.Tidal.Clock as Clock
+
+import Sound.Tidal.Stream.Config
+
+data Stream = Stream {sConfig :: Config,
+ sBusses :: MVar [Int],
+ sStateMV :: MVar ValueMap,
+ -- sOutput :: MVar ControlPattern,
+ sClockRef :: Clock.ClockRef,
+ sListen :: Maybe O.Udp,
+ sPMapMV :: MVar PlayMap,
+ sGlobalFMV :: MVar (ControlPattern -> ControlPattern),
+ sCxs :: [Cx]
+ }
+
+data Cx = Cx {cxTarget :: Target,
+ cxUDP :: O.Udp,
+ cxOSCs :: [OSC],
+ cxAddr :: N.AddrInfo,
+ cxBusAddr :: Maybe N.AddrInfo
+ }
+
+data StampStyle = BundleStamp
+ | MessageStamp
+ deriving (Eq, Show)
+
+data Schedule = Pre StampStyle
+ | Live
+ deriving (Eq, Show)
+
+data Target = Target {oName :: String,
+ oAddress :: String,
+ oPort :: Int,
+ oBusPort :: Maybe Int,
+ oLatency :: Double,
+ oWindow :: Maybe Arc,
+ oSchedule :: Schedule,
+ oHandshake :: Bool
+ }
+ deriving Show
+
+data Args = Named {requiredArgs :: [String]}
+ | ArgList [(String, Maybe Value)]
+ deriving Show
+
+data OSC = OSC {path :: String,
+ args :: Args
+ }
+ | OSCContext {path :: String}
+ deriving Show
+
+data PlayState = PlayState {pattern :: ControlPattern,
+ mute :: Bool,
+ solo :: Bool,
+ history :: [ControlPattern]
+ }
+ deriving Show
+
+type PatId = String
+type PlayMap = Map.Map PatId PlayState
+
+-- data TickState = TickState {
+-- tickArc :: Arc,
+-- tickNudge :: Double
+-- }
+-- deriving Show
+
+patternTimeID :: String
+patternTimeID = "_t_pattern"
diff --git a/src/Sound/Tidal/Stream/UI.hs b/src/Sound/Tidal/Stream/UI.hs
new file mode 100644
index 000000000..1ebeb4553
--- /dev/null
+++ b/src/Sound/Tidal/Stream/UI.hs
@@ -0,0 +1,154 @@
+{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}
+module Sound.Tidal.Stream.UI where
+
+import Data.Maybe (isJust)
+import qualified Data.Map as Map
+import qualified Control.Exception as E
+import Control.Concurrent.MVar
+import System.IO (hPutStrLn, stderr)
+import System.Random (getStdRandom, randomR)
+import qualified Sound.Osc.Fd as O
+
+import qualified Sound.Tidal.Clock as Clock
+import Sound.Tidal.Stream.Types
+import Sound.Tidal.Stream.Config
+import Sound.Tidal.Stream.Process
+import Sound.Tidal.Stream.Target
+
+import Sound.Tidal.Pattern
+import Sound.Tidal.ID
+
+streamNudgeAll :: Stream -> Double -> IO ()
+streamNudgeAll s = Clock.setNudge (sClockRef s)
+
+streamResetCycles :: Stream -> IO ()
+streamResetCycles s = streamSetCycle s 0
+
+streamSetCycle :: Stream -> Time -> IO ()
+streamSetCycle s = Clock.setClock (sClockRef s)
+
+streamSetBPM :: Stream -> Time -> IO ()
+streamSetBPM s = Clock.setBPM (sClockRef s)
+
+streamSetCPS :: Stream -> Time -> IO ()
+streamSetCPS s = Clock.setCPS (cClockConfig $ sConfig s) (sClockRef s)
+
+streamGetCPS :: Stream -> IO Time
+streamGetCPS s = Clock.getCPS (cClockConfig $ sConfig s)(sClockRef s)
+
+streamGetBPM :: Stream -> IO Time
+streamGetBPM s = Clock.getBPM (sClockRef s)
+
+streamGetNow :: Stream -> IO Time
+streamGetNow s = Clock.getCycleTime (cClockConfig $ sConfig s)(sClockRef s)
+
+streamEnableLink :: Stream -> IO ()
+streamEnableLink s = Clock.enableLink (sClockRef s)
+
+streamDisableLink :: Stream -> IO ()
+streamDisableLink s = Clock.disableLink (sClockRef s)
+
+streamList :: Stream -> IO ()
+streamList s = do pMap <- readMVar (sPMapMV s)
+ let hs = hasSolo pMap
+ putStrLn $ concatMap (showKV hs) $ Map.toList pMap
+ where showKV :: Bool -> (PatId, PlayState) -> String
+ showKV True (k, (PlayState {solo = True})) = k ++ " - solo\n"
+ showKV True (k, _) = "(" ++ k ++ ")\n"
+ showKV False (k, (PlayState {solo = False})) = k ++ "\n"
+ showKV False (k, _) = "(" ++ k ++ ") - muted\n"
+
+streamReplace :: Stream -> ID -> ControlPattern -> IO ()
+streamReplace stream k !pat = do
+ t <- Clock.getCycleTime (cClockConfig $ sConfig stream) (sClockRef stream)
+ E.handle (\ (e :: E.SomeException) -> do
+ hPutStrLn stderr $ "Failed to Stream.streamReplace: " ++ show e
+ hPutStrLn stderr $ "Return to previous pattern."
+ setPreviousPatternOrSilence (sPMapMV stream)) (updatePattern stream k t pat)
+
+ -- = modifyMVar_ (sActionsMV s) (\actions -> return $ (T.StreamReplace k pat) : actions)
+
+-- streamFirst but with random cycle instead of always first cicle
+streamOnce :: Stream -> ControlPattern -> IO ()
+streamOnce st p = do i <- getStdRandom $ randomR (0, 8192)
+ streamFirst st $ rotL (toRational (i :: Int)) p
+
+streamFirst :: Stream -> ControlPattern -> IO ()
+streamFirst stream pat = onSingleTick (sConfig stream) (sClockRef stream) (sStateMV stream) (sBusses stream) (sPMapMV stream) (sGlobalFMV stream) (sCxs stream) (sListen stream) pat
+
+streamMute :: Stream -> ID -> IO ()
+streamMute s k = withPatIds s [k] (\x -> x {mute = True})
+
+streamMutes :: Stream -> [ID] -> IO ()
+streamMutes s ks = withPatIds s ks (\x -> x {mute = True})
+
+streamUnmute :: Stream -> ID -> IO ()
+streamUnmute s k = withPatIds s [k] (\x -> x {mute = False})
+
+streamSolo :: Stream -> ID -> IO ()
+streamSolo s k = withPatIds s [k] (\x -> x {solo = True})
+
+streamUnsolo :: Stream -> ID -> IO ()
+streamUnsolo s k = withPatIds s [k] (\x -> x {solo = False})
+
+withPatIds :: Stream -> [ID] -> (PlayState -> PlayState) -> IO ()
+withPatIds s ks f
+ = do playMap <- takeMVar $ sPMapMV s
+ let pMap' = foldr (Map.update (\x -> Just $ f x)) playMap (map fromID ks)
+ putMVar (sPMapMV s) pMap'
+ return ()
+
+-- TODO - is there a race condition here?
+streamMuteAll :: Stream -> IO ()
+streamMuteAll s = modifyMVar_ (sPMapMV s) $ return . fmap (\x -> x {mute = True})
+
+streamHush :: Stream -> IO ()
+streamHush s = modifyMVar_ (sPMapMV s) $ return . fmap (\x -> x {pattern = silence, history = silence:history x})
+
+streamUnmuteAll :: Stream -> IO ()
+streamUnmuteAll s = modifyMVar_ (sPMapMV s) $ return . fmap (\x -> x {mute = False})
+
+streamUnsoloAll :: Stream -> IO ()
+streamUnsoloAll s = modifyMVar_ (sPMapMV s) $ return . fmap (\x -> x {solo = False})
+
+streamSilence :: Stream -> ID -> IO ()
+streamSilence s k = withPatIds s [k] (\x -> x {pattern = silence, history = silence:history x})
+
+streamAll :: Stream -> (ControlPattern -> ControlPattern) -> IO ()
+streamAll s f = do _ <- swapMVar (sGlobalFMV s) f
+ return ()
+
+streamGet :: Stream -> String -> IO (Maybe Value)
+streamGet s k = Map.lookup k <$> readMVar (sStateMV s)
+
+streamSet :: Valuable a => Stream -> String -> Pattern a -> IO ()
+streamSet s k pat = do sMap <- takeMVar $ sStateMV s
+ let pat' = toValue <$> pat
+ sMap' = Map.insert k (VPattern pat') sMap
+ putMVar (sStateMV s) $ sMap'
+
+streamSetI :: Stream -> String -> Pattern Int -> IO ()
+streamSetI = streamSet
+
+streamSetF :: Stream -> String -> Pattern Double -> IO ()
+streamSetF = streamSet
+
+streamSetS :: Stream -> String -> Pattern String -> IO ()
+streamSetS = streamSet
+
+streamSetB :: Stream -> String -> Pattern Bool -> IO ()
+streamSetB = streamSet
+
+streamSetR :: Stream -> String -> Pattern Rational -> IO ()
+streamSetR = streamSet
+
+-- It only really works to handshake with one target at the moment..
+sendHandshakes :: Stream -> IO ()
+sendHandshakes stream = mapM_ sendHandshake $ filter (oHandshake . cxTarget) (sCxs stream)
+ where sendHandshake cx = if (isJust $ sListen stream)
+ then
+ do -- send it _from_ the udp socket we're listening to, so the
+ -- replies go back there
+ sendO False (sListen stream) cx $ O.Message "/dirt/handshake" []
+ else
+ hPutStrLn stderr "Can't handshake with SuperCollider without control port."
diff --git a/src/Sound/Tidal/StreamTypes.hs b/src/Sound/Tidal/StreamTypes.hs
deleted file mode 100644
index 6b4fa76ea..000000000
--- a/src/Sound/Tidal/StreamTypes.hs
+++ /dev/null
@@ -1,24 +0,0 @@
-module Sound.Tidal.StreamTypes where
-
-import qualified Data.Map.Strict as Map
-import Sound.Tidal.Pattern
-import Sound.Tidal.Show ()
-
-data PlayState = PlayState {pattern :: ControlPattern,
- mute :: Bool,
- solo :: Bool,
- history :: [ControlPattern]
- }
- deriving Show
-
-type PatId = String
-type PlayMap = Map.Map PatId PlayState
-
-data TickState = TickState {
- tickArc :: Arc,
- tickNudge :: Double
- }
- deriving Show
-
-patternTimeID :: String
-patternTimeID = "_t_pattern"
diff --git a/src/Sound/Tidal/Tempo.hs b/src/Sound/Tidal/Tempo.hs
deleted file mode 100644
index 3b505158a..000000000
--- a/src/Sound/Tidal/Tempo.hs
+++ /dev/null
@@ -1,300 +0,0 @@
-{-# LANGUAGE ConstraintKinds, GeneralizedNewtypeDeriving, FlexibleContexts, ScopedTypeVariables, BangPatterns #-}
-{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns -fno-warn-orphans #-}
-
-
-module Sound.Tidal.Tempo where
-
-import Control.Concurrent.MVar
-import qualified Sound.Tidal.Pattern as P
-import qualified Sound.Osc.Fd as O
-import Control.Concurrent (forkIO, ThreadId, threadDelay)
-import Control.Monad (when)
-import qualified Data.Map.Strict as Map
-import qualified Control.Exception as E
-import Sound.Tidal.ID
-import Sound.Tidal.Config
-import Sound.Tidal.Utils (writeError)
-import qualified Sound.Tidal.Link as Link
-import Foreign.C.Types (CDouble(..))
-import System.IO (hPutStrLn, stderr)
-import Data.Int(Int64)
-
-import Sound.Tidal.StreamTypes
-
-{-
- Tempo.hs - Tidal's scheduler
- Copyright (C) 2020, Alex McLean and contributors
-
- This library is free software: you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
-
- This library is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this library. If not, see .
--}
-
-instance Show O.Udp where
- show _ = "-unshowable-"
-
-type TransitionMapper = P.Time -> [P.ControlPattern] -> P.ControlPattern
-
-data TempoAction =
- SetCycle P.Time
- | SingleTick P.ControlPattern
- | SetNudge Double
- | StreamReplace ID P.ControlPattern
- | Transition Bool TransitionMapper ID P.ControlPattern
-
-data State = State {ticks :: Int64,
- start :: Link.Micros,
- nowArc :: P.Arc,
- nudged :: Double
- }
- deriving Show
-
-data ActionHandler =
- ActionHandler {
- onTick :: TickState -> LinkOperations -> P.ValueMap -> IO P.ValueMap,
- onSingleTick :: LinkOperations -> P.ValueMap -> P.ControlPattern -> IO P.ValueMap,
- updatePattern :: ID -> P.Time -> P.ControlPattern -> IO ()
- }
-
-data LinkOperations =
- LinkOperations {
- timeAtBeat :: Link.Beat -> IO Link.Micros,
- timeToCycles :: Link.Micros -> IO P.Time,
- getTempo :: IO Link.BPM,
- setTempo :: Link.BPM -> Link.Micros -> IO (),
- linkToOscTime :: Link.Micros -> O.Time,
- beatToCycles :: CDouble -> CDouble,
- cyclesToBeat :: CDouble -> CDouble
- }
-
-setCycle :: P.Time -> MVar [TempoAction] -> IO ()
-setCycle cyc actionsMV = modifyMVar_ actionsMV (\actions -> return $ SetCycle cyc : actions)
-
-setNudge :: MVar [TempoAction] -> Double -> IO ()
-setNudge actionsMV nudge = modifyMVar_ actionsMV (\actions -> return $ SetNudge nudge : actions)
-
-timeToCycles' :: Config -> Link.SessionState -> Link.Micros -> IO P.Time
-timeToCycles' config ss time = do
- beat <- Link.beatAtTime ss time (cQuantum config)
- return $! (toRational beat) / (toRational (cBeatsPerCycle config))
-
--- At what time does the cycle occur according to Link?
-cyclesToTime :: Config -> Link.SessionState -> P.Time -> IO Link.Micros
-cyclesToTime config ss cyc = do
- let beat = (fromRational cyc) * (cBeatsPerCycle config)
- Link.timeAtBeat ss beat (cQuantum config)
-
-addMicrosToOsc :: Link.Micros -> O.Time -> O.Time
-addMicrosToOsc m t = ((fromIntegral m) / 1000000) + t
-
--- clocked assumes tempoMV is empty
-clocked :: Config -> MVar P.ValueMap -> MVar PlayMap -> MVar [TempoAction] -> ActionHandler -> Link.AbletonLink -> IO [ThreadId]
-clocked config stateMV mapMV actionsMV ac abletonLink
- = do -- TODO - do something with thread id
- clockTid <- forkIO $ loopInit
- return $! [clockTid]
- where frameTimespan :: Link.Micros
- frameTimespan = round $ (cFrameTimespan config) * 1000000
- quantum :: CDouble
- quantum = cQuantum config
- beatsPerCycle :: CDouble
- beatsPerCycle = cBeatsPerCycle config
- loopInit :: IO a
- loopInit =
- do
- when (cEnableLink config) $ Link.enable abletonLink
- sessionState <- Link.createAndCaptureAppSessionState abletonLink
- now <- Link.clock abletonLink
- let startAt = now + processAhead
- Link.requestBeatAtTime sessionState 0 startAt quantum
- Link.commitAndDestroyAppSessionState abletonLink sessionState
- putMVar actionsMV []
- let st = State {ticks = 0,
- start = now,
- nowArc = P.Arc 0 0,
- nudged = 0
- }
- checkArc $! st
- -- Time is processed at a fixed rate according to configuration
- -- logicalTime gives the time when a tick starts based on when
- -- processing first started.
- logicalTime :: Link.Micros -> Int64 -> Link.Micros
- logicalTime startTime ticks' = startTime + ticks' * frameTimespan
- -- tick moves the logical time forward or recalculates the ticks in case
- -- the logical time is out of sync with Link time.
- -- tick delays the thread when logical time is ahead of Link time.
- tick :: State -> IO a
- tick st = do
- now <- Link.clock abletonLink
- let preferredNewTick = ticks st + 1
- logicalNow = logicalTime (start st) preferredNewTick
- aheadOfNow = now + processAhead
- actualTick = (aheadOfNow - start st) `div` frameTimespan
- drifted = abs (actualTick - preferredNewTick) > cSkipTicks config
- newTick | drifted = actualTick
- | otherwise = preferredNewTick
- st' = st {ticks = newTick}
- delta = min frameTimespan (logicalNow - aheadOfNow)
- if drifted
- then writeError $ "skip: " ++ (show (actualTick - ticks st))
- else when (delta > 0) $ threadDelay $ fromIntegral delta
- checkArc st'
- -- The reference time Link uses,
- -- is the time the audio for a certain beat hits the speaker.
- -- Processing of the nowArc should happen early enough for
- -- all events in the nowArc to hit the speaker, but not too early.
- -- Processing thus needs to happen a short while before the start
- -- of nowArc. How far ahead is controlled by cProcessAhead.
- processAhead :: Link.Micros
- processAhead = round $ (cProcessAhead config) * 1000000
- checkArc :: State -> IO a
- checkArc st = do
- actions <- swapMVar actionsMV []
- st' <- processActions st actions
- let logicalEnd = logicalTime (start st') $ ticks st' + 1
- nextArcStartCycle = P.stop $ nowArc st'
- ss <- Link.createAndCaptureAppSessionState abletonLink
- arcStartTime <- cyclesToTime config ss nextArcStartCycle
- Link.destroySessionState ss
- if (arcStartTime < logicalEnd)
- then processArc st'
- else tick st'
- processArc :: State -> IO a
- processArc st =
- do
- streamState <- takeMVar stateMV
- let logicalEnd = logicalTime (start st) $ ticks st + 1
- startCycle = P.stop $ nowArc st
- sessionState <- Link.createAndCaptureAppSessionState abletonLink
- endCycle <- timeToCycles' config sessionState logicalEnd
- let st' = st {nowArc = P.Arc startCycle endCycle}
- nowOsc <- O.time
- nowLink <- Link.clock abletonLink
- let ops = LinkOperations {
- timeAtBeat = \beat -> Link.timeAtBeat sessionState beat quantum ,
- timeToCycles = timeToCycles' config sessionState,
- getTempo = Link.getTempo sessionState,
- setTempo = Link.setTempo sessionState,
- linkToOscTime = \lt -> addMicrosToOsc (lt - nowLink) nowOsc,
- beatToCycles = btc,
- cyclesToBeat = ctb
- }
- let state = TickState {
- tickArc = nowArc st',
- tickNudge = nudged st'
- }
- streamState' <- (onTick ac) state ops streamState
- Link.commitAndDestroyAppSessionState abletonLink sessionState
- putMVar stateMV streamState'
- tick st'
- btc :: CDouble -> CDouble
- btc beat = beat / beatsPerCycle
- ctb :: CDouble -> CDouble
- ctb cyc = cyc * beatsPerCycle
- processActions :: State -> [TempoAction] -> IO State
- processActions st [] = return $! st
- processActions st actions = do
- streamState <- takeMVar stateMV
- (st', streamState') <- handleActions st actions streamState
- putMVar stateMV streamState'
- return $! st'
- handleActions :: State -> [TempoAction] -> P.ValueMap -> IO (State, P.ValueMap)
- handleActions st [] streamState = return (st, streamState)
- handleActions st (SetCycle cyc : otherActions) streamState =
- do
- (st', streamState') <- handleActions st otherActions streamState
- sessionState <- Link.createAndCaptureAppSessionState abletonLink
-
- now <- Link.clock abletonLink
- let startAt = now + processAhead
- beat = (fromRational cyc) * (cBeatsPerCycle config)
- Link.requestBeatAtTime sessionState beat startAt quantum
- Link.commitAndDestroyAppSessionState abletonLink sessionState
-
-
- let st'' = st' {
- ticks = 0,
- start = now,
- nowArc = P.Arc cyc cyc
- }
-
- return (st'', streamState')
- handleActions st (SingleTick pat : otherActions) streamState =
- do
- (st', streamState') <- handleActions st otherActions streamState
- -- onSingleTick assumes it runs at beat 0.
- -- The best way to achieve that is to use forceBeatAtTime.
- -- But using forceBeatAtTime means we can not commit its session state.
- -- Another session state, which we will commit,
- -- is introduced to keep track of tempo changes.
- sessionState <- Link.createAndCaptureAppSessionState abletonLink
- zeroedSessionState <- Link.createAndCaptureAppSessionState abletonLink
- nowOsc <- O.time
- nowLink <- Link.clock abletonLink
- Link.forceBeatAtTime zeroedSessionState 0 (nowLink + processAhead) quantum
- let ops = LinkOperations {
- timeAtBeat = \beat -> Link.timeAtBeat zeroedSessionState beat quantum,
- timeToCycles = timeToCycles' config zeroedSessionState,
- getTempo = Link.getTempo zeroedSessionState,
- setTempo = \bpm micros ->
- Link.setTempo zeroedSessionState bpm micros >>
- Link.setTempo sessionState bpm micros,
- linkToOscTime = \lt -> addMicrosToOsc (lt - nowLink) nowOsc,
- beatToCycles = btc,
- cyclesToBeat = ctb
- }
- streamState'' <- (onSingleTick ac) ops streamState' pat
- Link.commitAndDestroyAppSessionState abletonLink sessionState
- Link.destroySessionState zeroedSessionState
- return (st', streamState'')
- handleActions st (SetNudge nudge : otherActions) streamState =
- do
- (st', streamState') <- handleActions st otherActions streamState
- let st'' = st' {nudged = nudge}
- return (st'', streamState')
- handleActions st (StreamReplace k pat : otherActions) streamState =
- do
- (st', streamState') <- handleActions st otherActions streamState
- E.catch (
- do
- now <- Link.clock abletonLink
- sessionState <- Link.createAndCaptureAppSessionState abletonLink
- cyc <- timeToCycles' config sessionState now
- Link.destroySessionState sessionState
- (updatePattern ac) k cyc pat
- return (st', streamState')
- )
- (\(e :: E.SomeException) -> do
- hPutStrLn stderr $ "Error in pattern: " ++ show e
- return (st', streamState')
- )
- handleActions st (Transition historyFlag f patId pat : otherActions) streamState =
- do
- (st', streamState') <- handleActions st otherActions streamState
- let
- appendPat flag = if flag then (pat:) else id
- updatePS (Just playState) = playState {history = (appendPat historyFlag) (history playState)}
- updatePS Nothing = PlayState {pattern = P.silence,
- mute = False,
- solo = False,
- history = (appendPat historyFlag) (P.silence:[])
- }
- transition' pat' = do now <- Link.clock abletonLink
- ss <- Link.createAndCaptureAppSessionState abletonLink
- c <- timeToCycles' config ss now
- return $! f c pat'
- pMap <- readMVar mapMV
- let playState = updatePS $ Map.lookup (fromID patId) pMap
- pat' <- transition' $ appendPat (not historyFlag) (history playState)
- let pMap' = Map.insert (fromID patId) (playState {pattern = pat'}) pMap
- _ <- swapMVar mapMV pMap'
- return (st', streamState')
diff --git a/src/Sound/Tidal/Time.hs b/src/Sound/Tidal/Time.hs
index b65a655d4..8f0aa9e01 100644
--- a/src/Sound/Tidal/Time.hs
+++ b/src/Sound/Tidal/Time.hs
@@ -36,7 +36,7 @@ instance (Fractional a) => Fractional (ArcF a) where
recip = fmap recip
fromRational = pure . fromRational
--- Utility functions - Time
+-- * Utility functions - Time
-- | The @sam@ (start of cycle) for the given time value.
-- Cycles have duration 1, so every integer Time value divides two cycles.
@@ -59,7 +59,7 @@ nextSam = (1+) . sam
cyclePos :: Time -> Time
cyclePos t = t - sam t
--- Utility functions - Arc
+-- * Utility functions - Arc
-- | convex hull union
hull :: Arc -> Arc -> Arc
@@ -109,9 +109,9 @@ cycleArc (Arc s e) = Arc (cyclePos s) (cyclePos s + (e-s))
-- Thus, for instance, @cyclesInArc (Arc 0 1.5) == [0,1]@.)
--
-- Edge cases:
--- > cyclesInArc $ Arc 0 1.0001 == [0,1]
--- > cyclesInArc $ Arc 0 1 == [0] -- the endpoint is excluded
--- > cyclesInArc $ Arc 1 1 == [1] -- unless the Arc has duration 0
+-- > cyclesInArc $ Arc 0 1.0001 == [0,1]
+-- > cyclesInArc $ Arc 0 1 == [0] -- the endpoint is excluded
+-- > cyclesInArc $ Arc 1 1 == [1] -- unless the Arc has duration 0
--
-- PITFALL: Don't be fooled by the name. The output cycles
-- are not necessarily completely contained in the input @Arc@,
diff --git a/src/Sound/Tidal/Transition.hs b/src/Sound/Tidal/Transition.hs
index c4139325b..b976c72b2 100644
--- a/src/Sound/Tidal/Transition.hs
+++ b/src/Sound/Tidal/Transition.hs
@@ -4,18 +4,20 @@ module Sound.Tidal.Transition where
import Prelude hiding ((<*), (*>))
-import Control.Concurrent.MVar (modifyMVar_)
+import Control.Concurrent.MVar (readMVar, swapMVar)
import qualified Data.Map.Strict as Map
-- import Data.Maybe (fromJust)
import Sound.Tidal.Control
import Sound.Tidal.Core
+import Sound.Tidal.Stream.Config
import Sound.Tidal.ID
import Sound.Tidal.Params (gain, pan)
import Sound.Tidal.Pattern
-import Sound.Tidal.Stream
-import Sound.Tidal.Tempo as T
+import Sound.Tidal.Stream.Types
+import qualified Sound.Tidal.Clock as Clock
+-- import Sound.Tidal.Tempo as T
import Sound.Tidal.UI (fadeOutFrom, fadeInFrom)
import Sound.Tidal.Utils (enumerate)
@@ -37,11 +39,30 @@ import Sound.Tidal.Utils (enumerate)
along with this library. If not, see .
-}
+type TransitionMapper = Time -> [ControlPattern] -> ControlPattern
+
-- Evaluation of pat is forced so exceptions are picked up here, before replacing the existing pattern.
-- the "historyFlag" determines if the new pattern should be placed on the history stack or not
-transition :: Stream -> Bool -> (Time -> [ControlPattern] -> ControlPattern) -> ID -> ControlPattern -> IO ()
-transition stream historyFlag f patId !pat =
- modifyMVar_ (sActionsMV stream) (\actions -> return $! (T.Transition historyFlag f patId pat) : actions)
+transition :: Stream -> Bool -> TransitionMapper -> ID -> ControlPattern -> IO ()
+transition stream historyFlag mapper patId !pat = do
+ let
+ appendPat flag = if flag then (pat:) else id
+ updatePS (Just playState) = playState {history = (appendPat historyFlag) (history playState)}
+ updatePS Nothing = PlayState {pattern = silence,
+ mute = False,
+ solo = False,
+ history = (appendPat historyFlag) (silence:[])
+ }
+ transition' pat' = do
+ t <- Clock.getCycleTime (cClockConfig $ sConfig stream) (sClockRef stream)
+ return $! mapper t pat'
+ pMap <- readMVar (sPMapMV stream)
+ let playState = updatePS $ Map.lookup (fromID patId) pMap
+ pat' <- transition' $ appendPat (not historyFlag) (history playState)
+ let pMap' = Map.insert (fromID patId) (playState {pattern = pat'}) pMap
+ _ <- swapMVar (sPMapMV stream) pMap'
+ return ()
+
mortalOverlay :: Time -> Time -> [Pattern a] -> Pattern a
mortalOverlay _ _ [] = silence
diff --git a/src/Sound/Tidal/UI.hs b/src/Sound/Tidal/UI.hs
index 21b62e03d..d0c28c952 100644
--- a/src/Sound/Tidal/UI.hs
+++ b/src/Sound/Tidal/UI.hs
@@ -64,7 +64,7 @@ Given a seed number, generates a reasonably random number out of it.
This is an efficient algorithm suitable for use in tight loops and used
to implement the below functions, which are used to implement 'rand'.
-See George Marsaglia (2003). ["Xorshift RNGs"](@https://www.jstatsoft.org/article/view/v008i14@),
+See George Marsaglia (2003). ["Xorshift RNGs"](https://www.jstatsoft.org/article/view/v008i14),
in Journal of Statistical Software, pages 8–14.
-}
@@ -94,19 +94,20 @@ timeToRands' seed n
{-|
-`rand` generates a continuous pattern of (pseudo-)random numbers between @0@ and @1@.
+@rand@ is an oscillator that generates a continuous pattern of (pseudo-)random
+numbers between 0 and 1.
-@
-sound "bd*8" # pan rand
-@
+For example, to randomly pan around the stereo field:
-pans bass drums randomly, and
+> d1 $ sound "bd*8" # pan rand
-@
-sound "sn sn ~ sn" # gain rand
-@
+Or to enjoy a randomised speed from 0.5 to 1.5, add 0.5 to it:
+
+> d1 $ sound "arpy*4" # speed (rand + 0.5)
+
+To make the snares randomly loud and quiet:
-makes the snares randomly loud and quiet.
+> sound "sn sn ~ sn" # gain rand
Numbers coming from this pattern are \'seeded\' by time. So if you reset time
(using 'resetCycles', 'setCycle', or 'cps') the random pattern will emit the
@@ -116,15 +117,11 @@ 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:
-@
-jux (# gain rand) $ sound "sn sn ~ sn" # gain rand
-@
+> jux (# gain rand) $ sound "sn sn ~ sn" # gain rand
and with the juxed version shifted backwards for 1024 cycles:
-@
-jux (# ((1024 <~) $ gain rand)) $ sound "sn sn ~ sn" # gain rand
-@
+> jux (# ((1024 <~) $ gain rand)) $ sound "sn sn ~ sn" # gain rand
-}
rand :: Fractional a => Pattern a
rand = Pattern (\(State a@(Arc s e) _) -> [Event (Context []) Nothing a (realToFrac $ (timeToRand ((e + s)/2) :: Double))])
@@ -153,14 +150,15 @@ irand = (>>= _irand)
_irand :: Num a => Int -> Pattern a
_irand i = fromIntegral . (floor :: Double -> Int) . (* fromIntegral i) <$> rand
-{- | 1D Perlin (smooth) noise, works like rand but smoothly moves between random
-values each cycle. `perlinWith` takes a pattern as the RNG's "input" instead
-of automatically using the cycle count.
-@
-d1 $ s "arpy*32" # cutoff (perlinWith (saw * 4) * 2000)
-@
+{- | 1D Perlin (smooth) noise, works like 'rand' but smoothly moves between random
+values each cycle. @perlinWith@ takes a pattern as the random number generator's
+"input" instead of automatically using the cycle count.
+
+> d1 $ s "arpy*32" # cutoff (perlinWith (saw * 4) * 2000)
+
will generate a smooth random pattern for the cutoff frequency which will
-repeat every cycle (because the saw does)
+repeat every cycle (because the saw does).
+
The `perlin` function uses the cycle count as input and can be used much like @rand@.
-}
perlinWith :: Fractional a => Pattern Double -> Pattern a
@@ -170,23 +168,33 @@ perlinWith p = fmap realToFrac $ (interp) <$> (p-pa) <*> (timeToRand <$> pa) <*>
interp x a b = a + smootherStep x * (b-a)
smootherStep x = 6.0 * x**5 - 15.0 * x**4 + 10.0 * x**3
--- | As 'perlin' with a suitable choice of input pattern (@'sig' 'fromRational'@).
+{- | As 'perlin' with a suitable choice of input pattern (@'sig' 'fromRational'@).
+
+ The @perlin@ function produces a new random value to move to every cycle. If
+ you want a new random value to be generated more or less frequently, you can use
+ fast or slow, respectively:
+
+ > d1 $ sound "bd*32" # speed (fast 4 $ perlin + 0.5)
+ > d1 $ sound "bd*32" # speed (slow 4 $ perlin + 0.5)
+-}
perlin :: Fractional a => Pattern a
perlin = perlinWith (sig fromRational)
-{-| `perlin2With` is Perlin noise with a 2-dimensional input. This can be
+{-| @perlin2With@ is Perlin noise with a 2-dimensional input. This can be
useful for more control over how the randomness repeats (or doesn't).
@
d1
- $ s "[supersaw:-12*32]"
- # lpf (rangex 60 5000 $ perlin2With (cosine*2) (sine*2))
- # lpq 0.3
+ $ s "[supersaw:-12*32]"
+ # lpf (rangex 60 5000 $ perlin2With (cosine*2) (sine*2))
+ # lpq 0.3
@
-will generate a smooth random cutoff pattern that repeats every cycle without
-any reversals or discontinuities (because the 2D path is a circle).
-`perlin2` only needs one input because it uses the cycle count as the
-second input.
+
+The above will generate a smooth random cutoff pattern that repeats every cycle
+without any reversals or discontinuities (because the 2D path is a circle).
+
+See also: `perlin2`, which only needs one input because it uses the cycle count
+as the second input.
-}
perlin2With :: Pattern Double -> Pattern Double -> Pattern Double
perlin2With x y = (/2) . (+1) $ interp2 <$> xfrac <*> yfrac <*> dota <*> dotb <*> dotc <*> dotd where
@@ -209,23 +217,34 @@ perlin2With x y = (/2) . (+1) $ interp2 <$> xfrac <*> yfrac <*> dota <*> dotb <*
perlin2 :: Pattern Double -> Pattern Double
perlin2 = perlin2With (sig fromRational)
-{- | Randomly picks an element from the given list
+{- | Randomly picks an element from the given list.
@
sound "superpiano(3,8)" # note (choose ["a", "e", "g", "c"])
@
plays a melody randomly choosing one of the four notes \"a\", \"e\", \"g\", \"c\".
+
+As with all continuous patterns, you have to be careful to give them structure; in this case choose gives you an infinitely detailed stream of random choices.
+
+> choose = 'chooseBy' 'rand'
-}
choose :: [a] -> Pattern a
choose = chooseBy rand
-{- | Given a pattern of doubles, 'chooseBy' normalizes them so that each
+{- | Given a pattern of doubles, @chooseBy@ normalizes them so that each
corresponds to an index in the provided list. The returned pattern
contains the corresponding elements in the list.
+It is like choose, but instead of selecting elements of the list randomly, it
+uses the given pattern to select elements.
+
@'choose' = chooseBy 'rand'@
+
+The following results in the pattern @"a b c"@:
+
+> chooseBy "0 0.25 0.5" ["a","b","c","d"]
-}
chooseBy :: Pattern Double -> [a] -> Pattern a
chooseBy _ [] = silence
@@ -240,16 +259,14 @@ sound "superpiano(3,8)" # note (wchoose [("a",1), ("e",0.5), ("g",2), ("c",1)])
In the above example, the "a" and "c" notes are twice as likely to
play as the "e" note, and half as likely to play as the "g" note.
+> wchoose = 'wchooseBy' 'rand'
-}
wchoose :: [(a,Double)] -> Pattern a
wchoose = wchooseBy rand
-{- | Given a pattern of probabilities and an list of @(value, weight)@ pairs,
-'wchooseBy' creates a @'Pattern' value@ by choosing values based on those
-probabilities and, weighted appropriately by the weights in the list of pairs.
-
-@'wchoose' = wchooseBy 'rand'@
-
+{- | Given a pattern of probabilities and a list of @(value, weight)@ pairs,
+@wchooseBy@ creates a @'Pattern' value@ by choosing values based on those
+probabilities and weighted appropriately by the weights in the list of pairs.
-}
wchooseBy :: Pattern Double -> [(a,Double)] -> Pattern a
wchooseBy pat pairs = match <$> pat
@@ -259,41 +276,45 @@ wchooseBy pat pairs = match <$> pat
values = map fst pairs
total = sum $ map snd pairs
--- | @randcat ps@: does a @slowcat@ on the list of patterns @ps@ but
--- randomises the order in which they are played.
+{-| @randcat ps@: does a @slowcat@ on the list of patterns @ps@ but
+ randomises the order in which they are played.
+
+ > d1 $ sound (randcat ["bd*2 sn", "jvbass*3", "drum*2", "ht mt"])
+-}
randcat :: [Pattern a] -> Pattern a
randcat ps = spread' rotL (_segment 1 $ (% 1) . fromIntegral <$> (_irand (length ps) :: Pattern Int)) (slowcat ps)
--- | As 'randcat', but allowing weighted choice.
+{-| As 'randcat', but allowing weighted choice.
+
+ In the following, the first pattern is the most likely and will play about half the time, and the last pattern is the less likely, with only a 10% probability.
+
+ > d1 $ sound
+ > $ wrandcat
+ > [ ("bd*2 sn", 5), ("jvbass*3", 2), ("drum*2", 2), ("ht mt", 1) ]
+-}
wrandcat :: [(Pattern a, Double)] -> Pattern a
wrandcat ps = unwrap $ wchooseBy (segment 1 rand) ps
-{- | `degrade` randomly removes events from a pattern 50% of the time:
+{- | @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"
-@
+> 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 `?`
+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?] ~"
-@
+> d1 $ slow 2 $ sound "bd ~ sn bd ~ bd? [sn bd?] ~"
-You can also use `?` to randomly remove events from entire sub-patterns:
+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]"
-@
+> d1 $ slow 2 $ sound "[[[feel:5*8,feel*3] feel:3*8]?, feel*4]"
-}
degrade :: Pattern a -> Pattern a
degrade = _degradeBy 0.5
{- |
-Similar to `degrade`, `degradeBy` allows you to control the percentage of events that
+Similar to `degrade`, @degradeBy@ allows you to control the percentage of events that
are removed. For example, to remove events 90% of the time:
@
@@ -369,38 +390,43 @@ pattern before probabilities are taken into account.
sometimesBy' :: Pattern Double -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
sometimesBy' x f pat = overlay (degradeBy x pat) (unDegradeBy x $ f pat)
--- | @sometimes@ is an alias for @sometimesBy 0.5@.
+-- | @sometimes@ is an alias for @'sometimesBy' 0.5@.
sometimes :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
sometimes = sometimesBy 0.5
+-- | @sometimes'@ is an alias for @'sometimesBy'' 0.5@.
sometimes' :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
sometimes' = sometimesBy' 0.5
--- | @often@ is an alias for @sometimesBy 0.75@.
+-- | @often@ is an alias for @'sometimesBy' 0.75@.
often :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
often = sometimesBy 0.75
+-- | @often'@ is an alias for @'sometimesBy'' 0.75@.
often' :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
often' = sometimesBy' 0.75
--- | @rarely@ is an alias for @sometimesBy 0.25@.
+-- | @rarely@ is an alias for @'sometimesBy' 0.25@.
rarely :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
rarely = sometimesBy 0.25
+-- | @rarely'@ is an alias for @'sometimesBy'' 0.25@.
rarely' :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
rarely' = sometimesBy' 0.25
--- | @almostNever@ is an alias for @sometimesBy 0.1@.
+-- | @almostNever@ is an alias for @'sometimesBy' 0.1@.
almostNever :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
almostNever = sometimesBy 0.1
+-- | @almostNever'@ is an alias for @'sometimesBy'' 0.1@.
almostNever' :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
almostNever' = sometimesBy 0.1
--- | @almostAlways@ is an alias for @sometimesBy 0.9@.
+-- | @almostAlways@ is an alias for @'sometimesBy' 0.9@.
almostAlways :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
almostAlways = sometimesBy 0.9
+-- | @almostAlways'@ is an alias for @'sometimesBy'' 0.9@.
almostAlways' :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
almostAlways' = sometimesBy' 0.9
@@ -423,7 +449,10 @@ always = id
{- | @someCyclesBy@ is a cycle-by-cycle version of @'sometimesBy'@.
-@someCycles = someCyclesBy 0.5@
+ For example the following will either distort all of the events in a cycle, or
+ none of them:
+
+ > d1 $ someCyclesBy 0.5 (# crush 2) $ n "0 1 [~ 2] 3" # sound "arpy"
-}
someCyclesBy :: Pattern Double -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
someCyclesBy pd f pat = innerJoin $ (\d -> _someCyclesBy d f pat) <$> pd
@@ -432,29 +461,34 @@ _someCyclesBy :: Double -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_someCyclesBy x = when test
where test c = timeToRand (fromIntegral c :: Double) < x
+-- | Alias of 'someCyclesBy'.
somecyclesBy :: Pattern Double -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
somecyclesBy = someCyclesBy
--- | @someCycles = someCyclesBy 0.5@
+-- | @someCycles = 'someCyclesBy' 0.5@
someCycles :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
someCycles = someCyclesBy 0.5
+-- | Alias of 'someCycles'.
somecycles :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
somecycles = someCycles
-- ** Pattern transformations
+--
+-- $patternTransformations
+--
+-- Pattern transformations are functions generally of type
+-- @'Pattern' a -> 'Pattern' a@. This means they take a pattern of any type
+-- and return a pattern of that type.
-{- |
-Pattern transformations are functions generally of type @'Pattern' a -> 'Pattern' a@.
-This means they take a pattern of any type and return a pattern of that type.
-
-
-This transformation makes a pattern sound a bit like a breakbeat.
-
-Example:
+{-|
+@brak@ makes a pattern sound a bit like a breakbeat. It does this by, every
+other cycle, squashing the pattern to fit half a cycle, and offsetting it by a
+quarter of a cycle.
@
d1 $ sound (brak "bd sn kurt")
+d1 $ brak $ sound "[feel feel:3, hc:3 hc:2 hc:4 ho:1]"
@
-}
brak :: Pattern a -> Pattern a
@@ -488,16 +522,37 @@ iter = tParam _iter
_iter :: Int -> Pattern a -> Pattern a
_iter n p = slowcat $ map (\i -> (fromIntegral i % fromIntegral n) `rotL` p) [0 .. (n-1)]
--- | @iter'@ is the same as @iter@, but decrements the starting
--- subdivision instead of incrementing it.
+{- | @iter'@ is the same as @iter@, but decrements the starting
+subdivision instead of incrementing it. For example,
+
+@
+d1 $ iter' 4 $ sound "bd hh sn cp"
+@
+
+produces
+
+@
+bd hh sn cp
+cp bd hh sn
+sn cp bd hh
+hh sn cp bd
+@
+-}
iter' :: Pattern Int -> Pattern c -> Pattern c
iter' = tParam _iter'
_iter' :: Int -> Pattern a -> Pattern a
_iter' n p = slowcat $ map (\i -> (fromIntegral i % fromIntegral n) `rotR` p) [0 .. (n-1)]
--- | @palindrome p@ applies @rev@ to @p@ every other cycle, so that
--- the pattern alternates between forwards and backwards.
+{- | @palindrome p@ applies @rev@ to @p@ every other cycle, so that the pattern
+alternates between forwards and backwards. For example, these are equivalent:
+
+@
+d1 $ palindrome $ sound "arpy:0 arpy:1 arpy:2 arpy:3"
+d1 $ slow 2 $ sound "arpy:0 arpy:1 arpy:2 arpy:3 arpy:3 arpy:2 arpy:1 arpy:0"
+d1 $ every 2 rev $ sound "arpy:0 arpy:1 arpy:2 arpy:3"
+@
+-}
palindrome :: Pattern a -> Pattern a
palindrome p = slowAppend p (rev p)
@@ -520,43 +575,33 @@ fadeInFrom from dur p = innerJoin $ (`_degradeBy` p) <$> (from `rotR` _slow dur
{- | 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
+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"
-@
+> 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"
-@
+> 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"
-@
+> 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"
-@
+> d1 $ spread slow [2,4%3] $ sound "ho ho:2 ho:3 hc"
Note that if you pass @($)@ as the function to spread values over, you
can put functions as the list of values. ('spreadf' is an alias for @spread ($)@.)
For example:
-@
-d1 $ spread ($) [density 2, rev, slow 2, striate 3, (# speed "0.8")]
- $ sound "[bd*2 [~ bd]] [sn future]*2 cp jvbass*4"
-@
+> d1 $ spread ($) [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:
@@ -577,11 +622,8 @@ slowspread = spread
{- | @fastspread@ works the same as `spread`, but the result is squashed into a single cycle. If you gave four values to @spread@, then the result would seem to speed up by a factor of four. Compare these two:
-@
- d1 $ spread chop [4,64,32,16] $ sound "ho ho:2 ho:3 hc"
-
- d1 $ fastspread chop [4,64,32,16] $ sound "ho ho:2 ho:3 hc"
-@
+> d1 $ spread chop [4,64,32,16] $ sound "ho ho:2 ho:3 hc"
+> d1 $ fastspread chop [4,64,32,16] $ sound "ho ho:2 ho:3 hc"
There is also `slowspread`, which is an alias of @spread@.
-}
@@ -590,23 +632,21 @@ fastspread f xs p = fastcat $ map (`f` 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"
-@
+> 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"
-@
+> d1 $ spread' slow "[2 4%3, 3]" $ sound "ho ho:2 ho:3 hc"
-}
spread' :: Monad m => (a -> b -> m c) -> m a -> b -> m c
spread' f vpat pat = vpat >>= \v -> f v pat
{- | @spreadChoose f xs p@ is similar to `slowspread` but picks values from
-`xs` at random, rather than cycling through them in order.
+@xs@ at random, rather than cycling through them in order.
+
+> d1 $ spreadChoose ($) [gap 4, striate 4] $ sound "ho ho:2 ho:3 hc"
-}
spreadChoose :: (t -> t1 -> Pattern b) -> [t] -> t1 -> Pattern b
spreadChoose f vs p = do v <- _segment 1 (choose vs)
@@ -616,18 +656,24 @@ spreadChoose f vs p = do v <- _segment 1 (choose vs)
spreadr :: (t -> t1 -> Pattern b) -> [t] -> t1 -> Pattern b
spreadr = spreadChoose
-{-| Decide whether to apply one or another function depending on the result of a test function that is passed the current cycle as a number.
+{-| Decide whether to apply one or another function depending on the result of a test function, which is passed the current cycle as a number.
@
-d1 $ ifp ((== 0).(flip mod 2))
- (striate 4)
- (# coarse "24 48") $
- sound "hh hc"
+d1 $ ifp ((== 0) . flip mod 2)
+ (striate 4)
+ (# coarse "24 48")
+ $ sound "hh hc"
@
-This will apply @'striate' 4@ for every _even_ cycle and apply @# coarse "24 48"@ for every _odd_.
+This will apply @'striate' 4@ for every /even/ cycle and apply @# coarse "24 48"@ for every /odd/.
-Detail: As you can see the test function is arbitrary and does not rely on anything tidal specific. In fact it uses only plain haskell functionality, that is: it calculates the modulo of 2 of the current cycle which is either 0 (for even cycles) or 1. It then compares this value against 0 and returns the result, which is either `True` or `False`. This is what the `ifp` signature's first part signifies `(Int -> Bool)`, a function that takes a whole number and returns either `True` or `False`.
+Detail: As you can see the test function is arbitrary and does not rely on
+anything Tidal specific. In fact it uses only plain Haskell functionality, that
+is: it calculates the modulo of 2 of the current cycle which is either 0 (for
+even cycles) or 1. It then compares this value against 0 and returns the result,
+which is either @True@ or @False@. This is what the @ifp@ signature's first part
+signifies: @(Int -> Bool)@, a function that takes a whole number and returns
+either @True@ or @False@.
-}
ifp :: (Int -> Bool) -> (Pattern a -> Pattern a) -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
ifp test f1 f2 p = splitQueries $ p {query = q}
@@ -637,6 +683,7 @@ ifp test f1 f2 p = splitQueries $ p {query = q}
-- | @wedge t p p'@ combines patterns @p@ and @p'@ by squashing the
-- @p@ into the portion of each cycle given by @t@, and @p'@ into the
-- remainer of each cycle.
+-- > d1 $ wedge (1/4) (sound "bd*2 arpy*3 cp sn*2") (sound "odx [feel future]*2 hh hh")
wedge :: Pattern Time -> Pattern a -> Pattern a -> Pattern a
wedge pt pa pb = innerJoin $ (\t -> _wedge t pa pb) <$> pt
@@ -647,16 +694,14 @@ _wedge t p p' = overlay (_fastGap (1/t) p) (t `rotR` _fastGap (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,
+additional number. It applies the function to the pattern when the
+remainder of the current loop number divided by the first parameter
is greater or equal than the second parameter.
-For example the following makes every other block of four loops twice
+For example, the following makes every other block of four loops twice
as dense:
-@
-d1 $ whenmod 8 4 (density 2) (sound "bd sn kurt")
-@
+> d1 $ whenmod 8 4 (density 2) (sound "bd sn kurt")
-}
whenmod :: Pattern Time -> Pattern Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
whenmod a b f pat = innerJoin $ (\a' b' -> _whenmod a' b' f pat) <$> a <*> b
@@ -666,17 +711,21 @@ _whenmod a b = whenT (\t -> ((t `mod'` a) >= b ))
{- |
-@
-superimpose f p = stack [p, f p]
-@
+> 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.
+@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. The
+following are equivalent:
-@
-d1 $ superimpose (density 2) $ sound "bd sn [cp ht] hh"
-d1 $ superimpose ((# speed "2") . (0.125 <~)) $ sound "bd sn cp hh"
-@
+> d1 $ superimpose (fast 2) $ sound "bd sn [cp ht] hh"
+> d1 $ stack [sound "bd sn [cp ht] hh",
+> fast 2 $ sound "bd sn [cp ht] hh"
+> ]
+
+More examples:
+
+> d1 $ superimpose (density 2) $ sound "bd sn [cp ht] hh"
+> d1 $ superimpose ((# speed "2") . (0.125 <~)) $ sound "bd sn cp hh"
-}
superimpose :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
@@ -685,9 +734,11 @@ superimpose f p = stack [p, f p]
{- | @trunc@ truncates a pattern so that only a fraction of the pattern is played.
The following example plays only the first quarter of the pattern:
-@
-d1 $ trunc 0.25 $ sound "bd sn*2 cp hh*4 arpy bd*2 cp bd*2"
-@
+> d1 $ trunc 0.25 $ sound "bd sn*2 cp hh*4 arpy bd*2 cp bd*2"
+
+You can also pattern the first parameter, for example to cycle through three values, one per cycle:
+
+> d1 $ trunc "<0.75 0.25 1>" $ sound "bd sn:2 [mt rs] hc"
-}
trunc :: Pattern Time -> Pattern a -> Pattern a
trunc = tParam _trunc
@@ -695,19 +746,35 @@ trunc = tParam _trunc
_trunc :: Time -> Pattern a -> Pattern a
_trunc t = compress (0, t) . zoomArc (Arc 0 t)
-{- | @linger@ is similar to `trunc` but the truncated part of the pattern loops until the end of the cycle.
+{- | @linger@ is similar to `trunc`, in that it truncates a pattern so that
+only the first fraction of the pattern is played, but the truncated part of the
+pattern loops to fill the remainder of the cycle.
-@
-d1 $ linger 0.25 $ sound "bd sn*2 cp hh*4 arpy bd*2 cp bd*2"
-@
+> d1 $ linger 0.25 $ sound "bd sn*2 cp hh*4 arpy bd*2 cp bd*2"
+
+For example this repeats the first quarter, so you only hear a single repeating note:
+
+> d1 $ linger 0.25 $ n "0 2 [3 4] 2" # sound "arpy"
+
+or slightly more interesting, applied only every fourth cycle:
+
+> d1 $ every 4 (linger 0.25) $ n "0 2 [3 4] 2" # sound "arpy"
+
+or to a chopped-up sample:
+
+> d1 $ every 2 (linger 0.25) $ loopAt 2 $ chop 8 $ sound "breaks125"
+
+You can also pattern the first parameter, for example to cycle through three
+values, one per cycle:
+
+> d1 $ linger "<0.75 0.25 1>" $ sound "bd sn:2 [mt rs] hc"
+> d1 $ linger "<0.25 0.5 1>" $ loopAt 2 $ chop 8 $ sound "breaks125"
If you give it a negative number, it will linger on the last part of
the pattern, instead of the start of it. E.g. to linger on the last
quarter:
-@
-d1 $ linger (-0.25) $ sound "bd sn*2 cp hh*4 arpy bd*2 cp bd*2"
-@
+> d1 $ linger (-0.25) $ sound "bd sn*2 cp hh*4 arpy bd*2 cp bd*2"
-}
linger :: Pattern Time -> Pattern a -> Pattern a
linger = tParam _linger
@@ -717,18 +784,18 @@ _linger n p | n < 0 = _fast (1/n) $ zoomArc (Arc (1 + n) 1) p
| otherwise = _fast (1/n) $ zoomArc (Arc 0 n) p
{- |
-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:
+Use @within@ to apply a function to only a part of a pattern. It takes two
+arguments: a start time and an end time, specified as floats between 0 and 1,
+which are applied to the relevant pattern. Note that the second argument must be
+greater than the first for the function to have any effect.
-@
-d1 $ within (0, 0.5) (density 2) $ sound "bd*2 sn lt mt hh hh hh hh"
-@
+For example, to apply @'fast' 2@ to only the first half of a pattern:
-Or, to apply `(# speed "0.5") to only the last quarter of a pattern:
+> d1 $ within (0, 0.5) (fast 2) $ sound "bd*2 sn lt mt hh hh hh hh"
-@
-d1 $ within (0.75, 1) (# speed "0.5") $ 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 :: (Time, Time) -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
within (s, e) f p = stack [filterWhen (\t -> cyclePos t >= s && cyclePos t < e) $ f p,
@@ -744,30 +811,21 @@ The difference between the two occurs when applying functions that change the ti
within first applies the function to all notes in the cycle, then keeps the results in the specified interval, and then combines it with the old cycle (an "apply split combine" paradigm).
within' first keeps notes in the specified interval, then applies the function to these notes, and then combines it with the old cycle (a "split apply combine" paradigm).
-
For example, whereas using the standard version of within
-@
-d1 $ within (0, 0.25) (fast 2) $ sound "bd hh cp sd"
-@
+> d1 $ within (0, 0.25) (fast 2) $ sound "bd hh cp sd"
sounds like:
-@
-d1 $ sound "[bd hh] hh cp sd"
-@
+> d1 $ sound "[bd hh] hh cp sd"
using this alternative version, within'
-@
-d1 $ within' (0, 0.25) (fast 2) $ sound "bd hh cp sd"
-@
+> d1 $ within' (0, 0.25) (fast 2) $ sound "bd hh cp sd"
sounds like:
-@
-d1 $ sound "[bd bd] hh cp sd"
-@
+> d1 $ sound "[bd bd] hh cp sd"
-}
within' :: (Time, Time) -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
@@ -787,9 +845,7 @@ revArc a = within a rev
{- | You can use the @euclid@ function to apply a Euclidean algorithm over a
complex pattern, although the structure of that pattern will be lost:
-@
-d1 $ euclid 3 8 $ sound "bd*2 [sn cp]"
-@
+> d1 $ euclid 3 8 $ sound "bd*2 [sn cp]"
In the above, three sounds are picked from the pattern on the right according
to the structure given by the @euclid 3 8@. It ends up picking two @bd@ sounds, a
@@ -806,29 +862,55 @@ more about this in the paper
by Toussaint. Some examples from this paper are included below,
including rotation as a third parameter in some cases (see 'euclidOff').
-@
-- (2,5) : A thirteenth century Persian rhythm called Khafif-e-ramal.
-- (3,4) : The archetypal pattern of the Cumbia from Colombia, as well as a Calypso rhythm from Trinidad.
-- (3,5,2) : Another thirteenth century Persian rhythm by the name of Khafif-e-ramal, as well as a Rumanian folk-dance rhythm.
-- (3,7) : A Ruchenitza rhythm used in a Bulgarian folk-dance.
-- (3,8) : The Cuban tresillo pattern.
-- (4,7) : Another Ruchenitza Bulgarian folk-dance rhythm.
-- (4,9) : The Aksak rhythm of Turkey.
-- (4,11) : The metric pattern used by Frank Zappa in his piece titled Outside Now.
-- (5,6) : Yields the York-Samai pattern, a popular Arab rhythm.
-- (5,7) : The Nawakhat pattern, another popular Arab rhythm.
-- (5,8) : The Cuban cinquillo pattern.
-- (5,9) : A popular Arab rhythm called Agsag-Samai.
-- (5,11) : The metric pattern used by Moussorgsky in Pictures at an Exhibition.
-- (5,12) : The Venda clapping pattern of a South African children’s song.
-- (5,16) : The Bossa-Nova rhythm necklace of Brazil.
-- (7,8) : A typical rhythm played on the Bendir (frame drum).
-- (7,12) : A common West African bell pattern.
-- (7,16,14) : A Samba rhythm necklace from Brazil.
-- (9,16) : A rhythm necklace used in the Central African Republic.
-- (11,24,14) : A rhythm necklace of the Aka Pygmies of Central Africa.
-- (13,24,5) : Another rhythm necklace of the Aka Pygmies of the upper Sangha.
-@
++------------+-----------------------------------------------------------------+
+| Pattern | Example |
++============+=================================================================+
+| (2,5) | A thirteenth century Persian rhythm called Khafif-e-ramal. |
++------------+-----------------------------------------------------------------+
+| (3,4) | The archetypal pattern of the Cumbia from Colombia, as well as |
+| | a Calypso rhythm from Trinidad. |
++------------+-----------------------------------------------------------------+
+| (3,5,2) | Another thirteenth century Persian rhythm by the name of |
+| | Khafif-e-ramal, as well as a Rumanian folk-dance rhythm. |
++------------+-----------------------------------------------------------------+
+| (3,7) | A Ruchenitza rhythm used in a Bulgarian folk-dance. |
++------------+-----------------------------------------------------------------+
+| (3,8) | The Cuban tresillo pattern. |
++------------+-----------------------------------------------------------------+
+| (4,7) | Another Ruchenitza Bulgarian folk-dance rhythm. |
++------------+-----------------------------------------------------------------+
+| (4,9) | The Aksak rhythm of Turkey. |
++------------+-----------------------------------------------------------------+
+| (4,11) | The metric pattern used by Frank Zappa in his piece titled |
+| | Outside Now. |
++------------+-----------------------------------------------------------------+
+| (5,6) | Yields the York-Samai pattern, a popular Arab rhythm. |
++------------+-----------------------------------------------------------------+
+| (5,7) | The Nawakhat pattern, another popular Arab rhythm. |
++------------+-----------------------------------------------------------------+
+| (5,8) | The Cuban cinquillo pattern. |
++------------+-----------------------------------------------------------------+
+| (5,9) | A popular Arab rhythm called Agsag-Samai. |
++------------+-----------------------------------------------------------------+
+| (5,11) | The metric pattern used by Moussorgsky in |
+| | Pictures at an Exhibition. |
++------------+-----------------------------------------------------------------+
+| (5,12) | The Venda clapping pattern of a South African children’s song. |
++------------+-----------------------------------------------------------------+
+| (5,16) | The Bossa-Nova rhythm necklace of Brazil. |
++------------+-----------------------------------------------------------------+
+| (7,8) | A typical rhythm played on the Bendir (frame drum). |
++------------+-----------------------------------------------------------------+
+| (7,12) | A common West African bell pattern. |
++------------+-----------------------------------------------------------------+
+| (7,16,14) | A Samba rhythm necklace from Brazil. |
++------------+-----------------------------------------------------------------+
+| (9,16) | A rhythm necklace used in the Central African Republic. |
++------------+-----------------------------------------------------------------+
+| (11,24,14) | A rhythm necklace of the Aka Pygmies of Central Africa. |
++------------+-----------------------------------------------------------------+
+| (13,24,5) | Another rhythm necklace of the Aka Pygmies of the upper Sangha. |
++------------+-----------------------------------------------------------------+
There was once a shorter alias @e@ for this function. It has been removed, but you
may see references to it in older Tidal code.
@@ -842,11 +924,14 @@ _euclid n k a | n >= 0 = fastcat $ fmap (bool silence a) $ bjorklund (n,k)
{- |
-@euclidFull n k pa pb@ stacks @'euclid' n k pa@ with @'euclidInv' n k pb@. For example,
-to implement the traditional flamenco rhythm, you could use hard claps for the former
-and soft claps for the latter:
+@euclidFull n k pa pb@ stacks @'euclid' n k pa@ with @'euclidInv' n k pb@. That
+is, it plays one pattern on the euclidean rhythm and a different pattern on
+the off-beat.
-@d1 $ euclidFull 3 7 "realclaps" ("realclaps" # gain 0.8)@
+For example, to implement the traditional flamenco rhythm, you could use hard
+claps for the former and soft claps for the latter:
+
+> d1 $ euclidFull 3 7 "realclaps" ("realclaps" # gain 0.8)
-}
euclidFull :: Pattern Int -> Pattern Int -> Pattern a -> Pattern a -> Pattern a
@@ -854,16 +939,15 @@ euclidFull n k pa pb = stack [ euclid n k pa, euclidInv n k pb ]
-- | Less expressive than 'euclid' due to its constrained types, but may be more efficient.
_euclidBool :: Int -> Int -> Pattern Bool -- TODO: add 'euclidBool'?
-_euclidBool n k = fastFromList $ bjorklund (n,k)
+_euclidBool n k | n >= 0 = fastFromList $ bjorklund (n,k)
+ | otherwise = fastFromList $ fmap (not) $ bjorklund (-n,k)
_euclid' :: Int -> Int -> Pattern a -> Pattern a
_euclid' n k p = fastcat $ map (\x -> if x then p else silence) (bjorklund (n,k))
{- |
-
As 'euclid', but taking a third rotational parameter corresponding to the onset
at which to start the rhythm.
-
-}
euclidOff :: Pattern Int -> Pattern Int -> Pattern Int -> Pattern a -> Pattern a
euclidOff = tParam3 _euclidOff
@@ -899,9 +983,25 @@ _distrib xs p = boolsToPat (foldr distrib' (replicate (last xs) True) (reverse $
layers = map bjorklund . (zip<*>tail)
boolsToPat a b' = flip const <$> filterValues (== True) (fastFromList a) <* b'
-{- | `euclidInv` fills in the blanks left by `euclid`.
+{-| @euclidInv@ fills in the blanks left by `euclid`, i.e., it inverts the
+pattern.
-Whereas @euclid 3 8 "x"@ produces @"x ~ ~ x ~ ~ x ~"@, @euclidInv 3 8 "x"@ produces @"~ x x ~ x x ~ x"@.
+For example, whereas @euclid 3 8 "x"@ produces
+
+> "x ~ ~ x ~ ~ x ~"
+
+@euclidInv 3 8 "x"@ produces
+
+> "~ x x ~ x x ~ x"
+
+As another example, in
+
+> d1 $ stack [ euclid 5 8 $ s "bd"
+> , euclidInv 5 8 $ s "hh27"
+> ]
+
+the hi-hat event fires on every one of the eight even beats that the bass drum
+does not.
-}
euclidInv :: Pattern Int -> Pattern Int -> Pattern a -> Pattern a
euclidInv = tParam2 _euclidInv
@@ -1016,8 +1116,28 @@ pequal :: Ord a => Time -> Pattern a -> Pattern a -> Bool
pequal cycles p1 p2 = (sort $ arc p1 (0, cycles)) == (sort $ arc p2 (0, cycles))
-}
--- | @rot n p@ rotates the values in a pattern @p@ by @n@ beats to the left.
--- Example: @d1 $ every 4 (rot 2) $ slow 2 $ sound "bd hh hh hh"@
+{- | @rot n p@ "rotates" the values in a pattern @p@ by @n@ beats to the left,
+preserving its structure. For example, in the following, each value will shift
+to its neighbour's position one step to the left, so that @b@ takes the place of
+@a@, @a@ of @c@, and @c@ of @b@:
+
+> rot 1 "a ~ b c"
+
+The result is equivalent of:
+
+> "b ~ c a"
+
+The first parameter is the number of steps, and may be given as a pattern. For example, in
+
+> d1 $ rot "<0 0 1 3>" $ n "0 ~ 1 2 0 2 ~ 3*2" # sound "drum"
+
+the pattern will not be rotated for the first two cycles, but will rotate it
+by one the third cycle, and by three the fourth cycle.
+
+Additional example:
+
+> d1 $ every 4 (rot 2) $ slow 2 $ sound "bd hh hh hh"
+-}
rot :: Ord a => Pattern Int -> Pattern a -> Pattern a
rot = tParam _rot
@@ -1042,9 +1162,15 @@ _rot i pat = splitQueries $ pat {query = \st -> f st (query pat (st {arc = whole
p' <- subArc (part e) a
return e {part = p'}
--- | @segment n p@: ’samples’ the pattern @p@ at a rate of @n@
--- events per cycle. Useful for turning a continuous pattern into a
--- discrete one.
+{-| @segment n p@ ’samples’ the pattern @p@ at a rate of @n@ events per cycle.
+Useful for turning a continuous pattern into a discrete one.
+
+In the following example, the pattern originates from the shape of a sine
+wave, a continuous pattern. Without @segment@, the samples will get triggered
+at an undefined frequency which may be very high.
+
+> d1 $ n (slow 2 $ segment 16 $ range 0 32 $ sine) # sound "amencutup"
+-}
segment :: Pattern Time -> Pattern a -> Pattern a
segment = tParam _segment
@@ -1093,11 +1219,14 @@ toMIDI p = fromJust <$> (filterValues (isJust) (noteLookup <$> p))
{- | 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")
-@
+> 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).
+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 :: Pattern Int -> [a] -> Pattern Int -> Pattern a
@@ -1118,9 +1247,37 @@ permstep nSteps things p = unwrap $ (\n -> fastFromList $ concatMap (\x -> repli
perms 1 n = [[n]]
perms n total = concatMap (\x -> map (x:) $ perms (n-1) (total-x)) [1 .. (total-(n-1))]
--- | @struct a b@: structures pattern @b@ in terms of the pattern of
--- boolean values @a@. Only @True@ values in the boolean pattern are
--- used.
+{-|
+ @struct a b@ structures pattern @b@ in terms of the pattern of boolean
+ values @a@. Only @True@ values in the boolean pattern are used.
+
+ The following are equivalent:
+
+ > d1 $ struct ("t ~ t*2 ~") $ sound "cp"
+ > d1 $ sound "cp ~ cp*2 ~"
+
+ The structure comes from a boolean pattern, i.e. a binary pattern containing
+ true or false values. Above we only used true values, denoted by @t@. It’s also
+ possible to include false values with @f@, which @struct@ will simply treat as
+ silence. For example, this would have the same outcome as the above:
+
+ > d1 $ struct ("t f t*2 f") $ sound "cp"
+
+ These true / false binary patterns become useful when you conditionally
+ manipulate them, for example, ‘inverting’ the values using 'every' and 'inv':
+
+ > d1 $ struct (every 3 inv "t f t*2 f") $ sound "cp"
+
+ In the above, the boolean values will be ‘inverted’ every third cycle, so that
+ the structure comes from the @f@s rather than @t@. Note that euclidean patterns
+ also create true/false values, for example:
+
+ > d1 $ struct (every 3 inv "t(3,8)") $ sound "cp"
+
+ In the above, the euclidean pattern creates @"t f t f t f f t"@ which gets
+ inverted to @"f t f t f t t f"@ every third cycle. Note that if you prefer you
+ can use 1 and 0 instead of @t@ and @f@.
+-}
struct :: Pattern Bool -> Pattern a -> Pattern a
struct ps pv = filterJust $ (\a b -> if a then Just b else Nothing ) <$> ps <* pv
@@ -1163,11 +1320,21 @@ substruct' s p = p {query = \st -> concatMap (f st) (query s st)}
-- Ignore analog events (ones without wholes)
f _ _ = []
--- | @stripe n p@: repeats pattern @p@, @n@ times per cycle. So
--- similar to @fast@, but with random durations. The repetitions will
--- be continguous (touching, but not overlapping) and the durations
--- will add up to a single cycle. @n@ can be supplied as a pattern of
--- integers.
+{- | @stripe n p@: repeats pattern @p@ @n@ times per cycle, i.e., the first
+parameter gives the number of cycles to operate over. So, it is similar to
+@fast@, but with random durations. For example @stripe 2@ will repeat a pattern
+twice, over two cycles
+
+In the following example, the start of every third repetition of the @d1@
+pattern will match with the clap on the @d2@ pattern.
+
+> d1 $ stripe 3 $ sound "bd sd ~ [mt ht]"
+> d2 $ sound "cp"
+
+The repetitions will be contiguous (touching, but not overlapping) and the
+durations will add up to a single cycle. @n@ can be supplied as a pattern of
+integers.
+-}
stripe :: Pattern Int -> Pattern a -> Pattern a
stripe = tParam _stripe
@@ -1195,13 +1362,27 @@ parseLMRule' :: String -> [(Char, String)]
parseLMRule' str = map fixer $ parseLMRule str
where fixer (c,r) = (head c, r)
-{- | Returns the `n`th iteration of a [Lindenmayer System](https://en.wikipedia.org/wiki/L-system) with given start sequence.
+{- | Returns the @n@th iteration of a
+ [Lindenmayer System](https://en.wikipedia.org/wiki/L-system)
+ with given start sequence.
-An example
+ It takes an integer @b@, a Lindenmayer system rule set, and an initiating
+ string as input in order to generate an L-system tree string of @b@ iterations.
+ It can be used in conjunction with a step function to convert the generated
+ string into a playable pattern. For example,
+
+ > d1 $ slow 16
+ > $ sound
+ > $ step' ["feel:0", "sn:1", "bd:0"]
+ > ( take 512
+ > $ lindenmayer 5 "0:1~~~,1:0~~~2~~~~~0~~~2~,2:2~1~,~:~~1~" "0"
+ > )
+
+ generates an L-system with initiating string @"0"@ and maps it onto a list
+ of samples.
+
+ Complex L-system trees with many rules and iterations can sometimes result in unwieldy strings. Using @take n@ to only use the first @n@ elements of the string, along with a 'slow' function, can make the generated values more manageable.
-@
-lindenmayer 1 "a:b,b:ab" "ab" -> "bab"
-@
-}
lindenmayer :: Int -> String -> String -> String
lindenmayer _ _ [] = []
@@ -1232,12 +1413,11 @@ runMarkov n tp xi seed = reverse $ (iterate (markovStep $ renorm) [xi])!! (n-1)
r = timeToRand $ seed + (fromIntegral . length) xs / fromIntegral n
renorm = [ map (/ sum x) x | x <- tp ]
-{- @markovPat n xi tp@ generates a one-cycle pattern of @n@ steps in a Markov
+{- | @markovPat n xi tp@ generates a one-cycle pattern of @n@ steps in a Markov
chain starting from state @xi@ with transition matrix @tp@. Each row of the
transition matrix is automatically normalized. For example:
-@
-tidal> markovPat 8 1 [[3,5,2], [4,4,2], [0,1,0]]
+>>> markovPat 8 1 [[3,5,2], [4,4,2], [0,1,0]]
(0>⅛)|1
(⅛>¼)|2
(¼>⅜)|1
@@ -1246,7 +1426,7 @@ tidal> markovPat 8 1 [[3,5,2], [4,4,2], [0,1,0]]
(⅝>¾)|1
(¾>⅞)|1
(⅞>1)|0
-@ -}
+-}
markovPat :: Pattern Int -> Pattern Int -> [[Double]] -> Pattern Int
markovPat = tParam2 _markovPat
@@ -1255,62 +1435,84 @@ _markovPat n xi tp = splitQueries $ Pattern (\(State a@(Arc s _) _) ->
queryArc (listToPat $ runMarkov n tp xi (sam s)) a)
{-|
-Removes events from second pattern that don't start during an event from first.
+@mask@ takes a boolean pattern and ‘masks’ another pattern with it. That is,
+events are only carried over if they match within a ‘true’ event in the binary
+pattern, i.e., it removes events from the second pattern that don't start during
+an event from the first.
-Consider this, kind of messy rhythm without any rests.
+For example, consider this kind of messy rhythm without any rests.
-@
-d1 $ sound (slowcat ["sn*8", "[cp*4 bd*4, hc*5]"]) # n (run 8)
-@
+> d1 $ sound (slowcat ["sn*8", "[cp*4 bd*4, hc*5]"]) # n (run 8)
If we apply a mask to it
@
-d1 $ s (mask ("1 1 1 ~ 1 1 ~ 1" :: Pattern Bool)
- (slowcat ["sn*8", "[cp*4 bd*4, bass*5]"] ))
+d1 $ s ( mask ("1 1 1 ~ 1 1 ~ 1" :: Pattern Bool)
+ ( slowcat ["sn*8", "[cp*4 bd*4, bass*5]"] )
+ )
# n (run 8)
@
-Due to the use of `slowcat` here, the same mask is first applied to `"sn*8"` and in the next cycle to `"[cp*4 bd*4, hc*5]".
+Due to the use of `slowcat` here, the same mask is first applied to @"sn*8"@ and
+in the next cycle to @"[cp*4 bd*4, hc*5]"@.
-You could achieve the same effect by adding rests within the `slowcat` patterns, but mask allows you to do this more easily. It kind of keeps the rhythmic structure and you can change the used samples independently, e.g.
+You could achieve the same effect by adding rests within the `slowcat` patterns,
+but mask allows you to do this more easily. It kind of keeps the rhythmic
+structure and you can change the used samples independently, e.g.,
@
-d1 $ s (mask ("1 ~ 1 ~ 1 1 ~ 1")
- (slowcat ["can*8", "[cp*4 sn*4, jvbass*16]"] ))
+d1 $ s ( mask ("1 ~ 1 ~ 1 1 ~ 1")
+ ( slowcat ["can*8", "[cp*4 sn*4, jvbass*16]"] )
+ )
# n (run 8)
@
-}
mask :: Pattern Bool -> Pattern a -> Pattern a
mask b p = const <$> p <* (filterValues id b)
--- | TODO: refactor towards union
+-- TODO: refactor towards union
enclosingArc :: [Arc] -> Arc
enclosingArc [] = Arc 0 1
enclosingArc as = Arc (minimum (map start as)) (maximum (map stop as))
+{-|
+ @stretch@ takes a pattern, and if there’s silences at the start or end of the
+ current cycle, it will zoom in to avoid them. The following are equivalent:
+
+ > d1 $ note (stretch "~ 0 1 5 8*4 ~") # s "superpiano"
+ > d1 $ note "0 1 5 8*4" # s "superpiano"
+
+ You can pattern silences on the extremes of a cycle to make changes to the rhythm:
+
+ > d1 $ note (stretch "~ <0 ~> 1 5 8*4 ~") # s "superpiano"
+-}
stretch :: Pattern a -> Pattern a
-- TODO - should that be whole or part?
stretch p = splitQueries $ p {query = q}
where q st = query (zoomArc (cycleArc $ enclosingArc $ map wholeOrPart $ query p (st {arc = Arc (sam s) (nextSam s)})) p) st
where s = start $ arc st
-{- | `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:
+{- | @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")
-@
+> 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"`.
+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.
+> 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' :: Pattern Time -> Int -> Pattern Int -> Pattern Int -> Pattern a -> Pattern a
fit' cyc n from to p = squeezeJoin $ _fit n mapMasks to
@@ -1325,9 +1527,18 @@ fit' cyc n from to p = squeezeJoin $ _fit n mapMasks to
- from left to right if chunk number is positive
- from right to left if chunk number is negative
- @
- d1 $ chunk 4 (fast 4) $ sound "cp sn arpy [mt lt]"
- @
+ > d1 $ chunk 4 (fast 4) $ sound "cp sn arpy [mt lt]"
+
+ The following:
+
+ > d1 $ chunk 4 (# speed 2) $ sound "bd hh sn cp"
+
+ applies @(# speed 2)@ to the uppercased part of the cycle below:
+
+ > BD hh sn cp
+ > bd HH sn cp
+ > bd hh SN cp
+ > bd hh sn CP
-}
chunk :: Pattern Int -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b
chunk npat f p = innerJoin $ (\n -> _chunk n f p) <$> npat
@@ -1349,6 +1560,18 @@ _chunk' n f p = _chunk (-n) f p
@inside@ carries out an operation /inside/ a cycle.
For example, while @rev "0 1 2 3 4 5 6 7"@ is the same as @"7 6 5 4 3 2 1 0"@,
@inside 2 rev "0 1 2 3 4 5 6 7"@ gives @"3 2 1 0 7 6 5 4"@.
+
+What this function is really doing is ‘slowing down’ the pattern by a given
+factor, applying the given function to it, and then ‘speeding it up’ by the same
+factor. In other words, this:
+
+> inside 2 rev "0 1 2 3 4 5 6 7"
+
+Is doing this:
+
+> fast 2 $ rev $ slow 2 "0 1 2 3 4 5 6 7"
+
+so rather than whole cycles, each half of a cycle is reversed.
-}
inside :: Pattern Time -> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
inside np f p = innerJoin $ (\n -> _inside n f p) <$> np
@@ -1360,28 +1583,28 @@ _inside n f p = _fast n $ f (_slow n p)
@outside@ is the inverse of the 'inside' function. @outside@ applies its function /outside/ the cycle.
Say you have a pattern that takes 4 cycles to repeat and apply the rev function:
-@
-d1 $ rev $ cat [s "bd bd sn",s "sn sn bd", s"lt lt sd", s "sd sd bd"]
-@
+> d1 $ rev $ cat [s "bd bd sn",s "sn sn bd", s"lt lt sd", s "sd sd bd"]
The above generates:
-@
-d1 $ rev $ cat [s "sn bd bd",s "bd sn sn", s "sd lt lt", s "bd sd sd"]
-@
+> d1 $ rev $ cat [s "sn bd bd",s "bd sn sn", s "sd lt lt", s "bd sd sd"]
However if you apply @outside@:
-@
-d1 $ outside 4 (rev) $ cat [s "bd bd sn",s "sn sn bd", s"lt lt sd", s "sd sd bd"]
-@
+> d1 $ outside 4 (rev) $ cat [s "bd bd sn",s "sn sn bd", s"lt lt sd", s "sd sd bd"]
The result is:
-@
-d1 $ rev $ cat [s "bd sd sd", s "sd lt lt", s "sn sn bd", s "bd bd sn"]
-@
+> d1 $ rev $ cat [s "bd sd sd", s "sd lt lt", s "sn sn bd", s "bd bd sn"]
+Notice that the whole idea has been reversed. What this function is really doing
+is ‘speeding up’ the pattern by a given factor, applying the given function to
+it, and then ‘slowing it down’ by the same factor. In other words, this:
+
+> d1 $ slow 4 $ rev $ fast 4
+> $ cat [s "bd bd sn",s "sn sn bd", s"lt lt sd", s "sd sd bd"]
+
+This compresses the idea into a single cycle before rev operates and then slows it back to the original speed.
-}
outside :: Pattern Time -> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
outside np f p = innerJoin $ (\n -> _outside n f p) <$> np
@@ -1389,6 +1612,15 @@ outside np f p = innerJoin $ (\n -> _outside n f p) <$> np
_outside :: Time -> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
_outside n = _inside (1/n)
+{-|
+ Takes a pattern and loops only the first cycle of the pattern. For example, the following code will only play the bass drum sample:
+
+ > d1 $ loopFirst $ s "< cp*4>"
+
+ This function combines with 'sometimes' to insert events from the first cycle randomly into subsequent cycles of the pattern:
+
+ > d1 $ sometimes loopFirst $ s "< cp*4>"
+-}
loopFirst :: Pattern a -> Pattern a
loopFirst p = splitQueries $ p {query = f}
where f st = map
@@ -1402,6 +1634,15 @@ loopFirst p = splitQueries $ p {query = f}
timeLoop :: Pattern Time -> Pattern a -> Pattern a
timeLoop n = outside n loopFirst
+{-|
+ @seqPLoop@ will keep looping the sequence when it gets to the end:
+
+ > d1 $ qtrigger $ seqPLoop
+ > [ (0, 12, sound "bd bd*2")
+ > , (4, 12, sound "hh*2 [sn cp] cp future*4")
+ > , (8, 12, sound (samples "arpy*8" (run 16)))
+ > ]
+-}
seqPLoop :: [(Time, Time, Pattern a)] -> Pattern a
seqPLoop ps = timeLoop (pure $ maxT - minT) $ minT `rotL` seqP ps
where minT = minimum $ map (\(x,_,_) -> x) ps
@@ -1411,11 +1652,18 @@ seqPLoop ps = timeLoop (pure $ maxT - minT) $ minT `rotL` seqP ps
@toScale@ lets you turn a pattern of notes within a scale (expressed as a
list) to note numbers.
-For example: @toScale [0, 4, 7] "0 1 2 3"@ will turn
-into the pattern @"0 4 7 12"@.
+For example:
+
+> toScale [0, 4, 7] "0 1 2 3"
+
+will turn into the pattern @"0 4 7 12"@.
+
+@toScale@ is handy for quickly applying a scale without naming it:
+
+> d1 $ n (toScale [0,2,3,5,7,8,10] "0 1 2 3 4 5 6 7") # sound "superpiano"
-This function assumes your scale fits within an
-octave; if that's not true, use 'toScale''.
+This function assumes your scale fits within an octave; if that's not true,
+use 'toScale''.
@toScale = toScale' 12@
-}
@@ -1433,8 +1681,14 @@ toScale' o s = fmap noteInScale
noteInScale x = (s !!! x) + fromIntegral (o * octave x)
-{- | `swingBy x n` divides a cycle into `n` slices and delays the notes in
-the second half of each slice by `x` fraction of a slice.
+{- | @swingBy x n@ divides a cycle into @n@ slices and delays the notes in the
+ second half of each slice by @x@ fraction of a slice. So if @x@ is 0 it does
+ nothing, 0.5 delays for half the note duration, and 1 will wrap around to
+ doing nothing again. The end result is a shuffle or swing-like rhythm. For
+ example, the following will delay every other @"hh"@ 1/3 of the way to the
+ next @"hh"@:
+
+ > d1 $ swingBy (1/3) 4 $ sound "hh*8"
-}
swingBy :: Pattern Time -> Pattern Time -> Pattern a -> Pattern a
swingBy x n = inside n (withinArc (Arc 0.5 1) (x ~>))
@@ -1445,8 +1699,11 @@ As 'swingBy', with the cycle division set to ⅓.
swing :: Pattern Time -> Pattern a -> Pattern a
swing = swingBy (pure $ 1%3)
-{- | `cycleChoose` is like `choose` but only picks a new item from the list
-once each cycle -}
+{- | @cycleChoose@ is like `choose` but only picks a new item from the list
+ once each cycle.
+
+ > d1 $ sound "drum ~ drum drum" # n (cycleChoose [0,2,3])
+-}
cycleChoose :: [a] -> Pattern a
cycleChoose = segment 1 . choose
@@ -1461,8 +1718,10 @@ _rearrangeWith ipat n pat = innerJoin $ (\i -> _fast nT $ _repeatCycles n $ pats
{- | @shuffle n p@ evenly divides one cycle of the pattern @p@ into @n@ parts,
and returns a random permutation of the parts each cycle. For example,
@shuffle 3 "a b c"@ could return @"a b c"@, @"a c b"@, @"b a c"@, @"b c a"@,
-@"c a b"@, or @"c b a"@. But it will **never** return @"a a a"@, because that
+@"c a b"@, or @"c b a"@. But it will /never/ return @"a a a"@, because that
is not a permutation of the parts.
+
+This could also be called “sampling without replacement”.
-}
shuffle :: Pattern Int -> Pattern a -> Pattern a
shuffle = tParam _shuffle
@@ -1474,6 +1733,8 @@ _shuffle n = _rearrangeWith (randrun n) n
of @p@ instead of making permutations.
For example, @scramble 3 "a b c"@ will randomly select 3 parts from
@"a"@ @"b"@ and @"c"@, possibly repeating a single part.
+
+This could also be called “sampling with replacement”.
-}
scramble :: Pattern Int -> Pattern a -> Pattern a
scramble = tParam _scramble
@@ -1524,7 +1785,7 @@ seqP ps = stack $ map (\(s, e, p) -> playFor s e (sam s `rotR` p)) ps
{-|
The @ur@ function is designed for longer form composition, by allowing you to
-create ’patterns of patterns’ in a repeating loop. It takes four parameters:
+create ‘patterns of patterns’ in a repeating loop. It takes four parameters:
how long the loop will take, a pattern giving the structure of the composition,
a lookup table for named patterns to feed into that structure, and a second
lookup table for named transformations\/effects.
@@ -1539,24 +1800,50 @@ do it:
@
let pats =
- [
- ("a", stack [n "c4 c5 g4 f4 f5 g4 e5 g4" # s "superpiano" # gain "0.7",
- n "[c3,g4,c4]" # s "superpiano"# gain "0.7"
- ]
- ),
- ("b", stack [n "d4 c5 g4 f4 f5 g4 e5 g4" # s "superpiano" # gain "0.7",
- n "[d3,a4,d4]" # s "superpiano"# gain "0.7"
- ]
- ),
- ("c", stack [n "f4 c5 g4 f4 f5 g4 e5 g4" # s "superpiano" # gain "0.7",
- n "[f4,c5,f4]" # s "superpiano"# gain "0.7"
- ]
- )
- ]
+ [ ( "a", stack [ n "c4 c5 g4 f4 f5 g4 e5 g4" # s "superpiano" # gain "0.7"
+ , n "[c3,g4,c4]" # s "superpiano"# gain "0.7"
+ ]
+ )
+ , ( "b", stack [ n "d4 c5 g4 f4 f5 g4 e5 g4" # s "superpiano" # gain "0.7"
+ , n "[d3,a4,d4]" # s "superpiano"# gain "0.7"
+ ]
+ )
+ , ( "c", stack [ n "f4 c5 g4 f4 f5 g4 e5 g4" # s "superpiano" # gain "0.7"
+ , n "[f4,c5,f4]" # s "superpiano"# gain "0.7"
+ ]
+ )
+ ]
in
d1 $ ur 12 "a b c" pats []
@
+In the above, the fourth parameter is given as an empty list, but that is where
+you can put another lookup table, of functions rather than patterns this time.
+For example:
+
+@
+let
+ pats = ...
+ fx = [ ("reverb", ( # (room 0.8 # sz 0.99 # orbit 1)))
+ , ("faster", fast 2)
+ ]
+in
+d1 $ ur 12 "a b:reverb c:faster" pats fx
+@
+
+In this example, @b@ has the function applied that’s named as reverb, while @c@
+is made to go faster. It’s also possible to schedule multiple patterns at once,
+like in the following:
+
+@
+let pats = [ ("drums", s "drum cp*2")
+ , ("melody", s "arpy:2 arpy:3 arpy:5")
+ , ("craziness", s "cp:4*8" # speed ( sine + 0.5 ))
+ ]
+ fx = [("higher", ( # speed 2))]
+in
+d1 $ ur 8 "[drums, melody] [drums,craziness,melody] melody:higher" pats fx
+@
-}
ur :: Time -> Pattern String -> [(String, Pattern a)] -> [(String, Pattern a -> Pattern a)] -> Pattern a
ur t outer_p ps fs = _slow t $ unwrap $ adjust <$> timedValues (getPat . split <$> outer_p)
@@ -1573,7 +1860,25 @@ ur t outer_p ps fs = _slow t $ unwrap $ adjust <$> timedValues (getPat . split <
matchF str = fromMaybe id $ lookup str fs
timedValues = withEvent (\(Event c (Just a) a' v) -> Event c (Just a) a' (a,v)) . filterDigital
--- | A simpler version of 'ur' that just provides name-value bindings that are reflected in the provided pattern.
+{- | A simpler version of 'ur' that just provides name-value bindings that are
+ reflected in the provided pattern.
+
+ @inhabit@ allows you to link patterns to some @String@, or in other words,
+ to give patterns a name and then call them from within another pattern of
+ @String@s.
+
+ For example, we can make our own bassdrum, hi-hat and snaredrum kit:
+
+ > do
+ > let drum = inhabit [ ("bd", s "sine" |- accelerate 1.5)
+ > , ("hh", s "alphabet:7" # begin 0.7 # hpf 7000)
+ > , ("sd", s "invaders:3" # speed 12)
+ > ]
+ > d1 $ drum "[bd*8?, [~hh]*4, sd(6,16)]"
+
+ @inhabit@ can be very useful when using MIDI controlled drum machines, since you
+ can give understandable drum names to patterns of notes.
+-}
inhabit :: [(String, Pattern a)] -> Pattern String -> Pattern a
inhabit ps p = squeezeJoin $ (\s -> fromMaybe silence $ lookup s ps) <$> p
@@ -1586,13 +1891,32 @@ spaceOut xs p = _slow (toRational $ sum xs) $ stack $ map (`compressArc` p) spac
spaceArcs = map (\(Arc a b) -> Arc (a/s) (b/s)) $ markOut 0 xs
s = sum xs
--- | @flatpat@ takes a 'Pattern' of lists and pulls the list elements as
--- separate 'Event's.
+{-| @flatpat@ takes a 'Pattern' of lists and pulls the list elements as
+ separate 'Event's. For example, the following code uses @flatpat@ in combination with @listToPat@ to create an alternating pattern of chords:
+
+ > d1 $ n (flatpat $ listToPat [[0,4,7],[(-12),(-8),(-5)]])
+ > # s "superpiano" # sustain 2
+
+ This code is equivalent to:
+
+ > d1 $ n ("[0,4,7] [-12,-8,-5]") # s "superpiano" # sustain 2
+-}
flatpat :: Pattern [a] -> Pattern a
flatpat p = p {query = concatMap (\(Event c b b' xs) -> map (Event c b b') xs) . query p}
--- | @layer@ takes a list of 'Pattern'-returning functions and a seed element,
--- stacking the result of applying the seed element to each function in the list.
+{- | @layer@ takes a list of 'Pattern'-returning functions and a seed element,
+stacking the result of applying the seed element to each function in the list.
+
+It allows you to layer up multiple functions on one pattern. For example, the following
+will play two versions of the pattern at the same time, one reversed and one at twice
+the speed:
+
+> d1 $ layer [rev, fast 2] $ sound "arpy [~ arpy:4]"
+
+The original version of the pattern can be included by using the @id@ function:
+
+> d1 $ layer [id, rev, fast 2] $ sound "arpy [~ arpy:4]"
+-}
layer :: [a -> Pattern b] -> a -> Pattern b
layer fs p = stack $ map ($ p) fs
@@ -1631,7 +1955,7 @@ The different arpeggiate modes are:
@
up down updown downup up&down down&up converge
diverge disconverge pinkyup pinkyupdown
-thumbup thumbupdown-
+thumbup thumbupdown
@
-}
arp :: Pattern String -> Pattern a -> Pattern a
@@ -1664,8 +1988,11 @@ _arp name p = arpWith f p
thumbup xs = concatMap (\x -> [thumb,x]) $ tail xs
where thumb = head xs
-{- | `rolled` plays each note of a chord quickly in order, as opposed to simultaneously; to give a chord a harp-like effect.
-This will played from the lowest note to the highest note of the chord:
+{- | @rolled@ plays each note of a chord quickly in order, as opposed to
+simultaneously; to give a chord a harp-like or strum effect.
+
+Notes are played low to high, and are evenly distributed within (1/4) of the chord event length, as opposed to arp/arpeggiate that spread the notes over the whole event.
+
@
rolled $ n "c'maj'4" # s "superpiano"
@
@@ -1676,8 +2003,10 @@ rolled :: Pattern a -> Pattern a
rolled = rolledBy (1/4)
{-
-As 'rolled', but allowing you to specify the length of the roll. The value in the passed pattern
-is the divisor of the cycle length. A negative value will play the arpeggio in reverse order.
+As 'rolled', but allows you to specify the length of the roll, i.e., the
+fraction of the event that the notes will be spread over. The value in the
+passed pattern is the divisor of the cycle length. A negative value will play
+the arpeggio in reverse order.
@
rolledBy "<1 -0.5 0.25 -0.125>" $ note "c'maj9" # s "superpiano"
@@ -1722,7 +2051,28 @@ fill p' p = struct (splitQueries $ p {query = q}) p'
tolerance = 0.01
-}
--- | @ply n@ repeats each event @n@ times within its arc.
+{- | @ply n@ repeats each event @n@ times within its arc.
+
+For example, the following are equivalent:
+
+@
+d1 $ ply 3 $ s "bd ~ sn cp"
+d1 $ s "[bd bd bd] ~ [sn sn sn] [cp cp cp]"
+@
+
+The first parameter may be given as a pattern, so that the following are equivalent:
+
+@
+d1 $ ply "2 3" $ s "bd ~ sn cp"
+d1 $ s "[bd bd] ~ [sn sn sn] [cp cp cp]"
+@
+
+Here is an example of it being used conditionally:
+
+@
+d1 $ every 3 (ply 4) $ s "bd ~ sn cp"
+@
+-}
ply :: Pattern Rational -> Pattern a -> Pattern a
ply = tParam _ply
@@ -1738,26 +2088,99 @@ _plyWith numPat f p = arpeggiate $ compound numPat
where compound n | n <= 1 = p
| otherwise = overlay p (f $ compound $ n-1)
--- | Syncopates a rhythm, shifting each event halfway into its arc (aka timespan), e.g. @"a b [c d] e"@ becomes the equivalent of @"[~ a] [~ b] [[~ c] [~ d]] [~ e]"@
+{-| Syncopates a rhythm, shifting (delaying) each event halfway into its arc
+ (timespan).
+
+ In mini-notation terms, it basically turns every instance of a into @[~ a]@,
+ e.g., @"a b [c d] e"@ becomes the equivalent of
+ @"[~ a] [~ b] [[~ c] [~ d]] [~ e]"@.
+ Every beat then becomes an offbeat, and so the overall effect is to
+ syncopate a pattern.
+
+ In the following example, you can hear that the piano chords play between the
+ snare and the bass drum. In 4/4 time, they are playing in the 2 and a half,
+ and 4 and a half beats:
+
+ > do
+ > resetCycles
+ > d1 $ stack [
+ > press $ n "~ c'maj ~ c'maj" # s "superpiano" # gain 0.9 # pan 0.6,
+ > s "[bd,clap sd bd sd]" # pan 0.4
+ > ] # cps (90/60/4)
+
+ In the next example, the C major chord plays before the G major. As the slot
+ that occupies the C chord is that of one eighth note, it is displaced by press
+ only a sixteenth note:
+
+ > do
+ > resetCycles
+ > d1 $ stack [
+ > press $ n "~ [c'maj ~] ~ ~" # s "superpiano" # gain 0.9 # pan 0.6,
+ > press $ n "~ g'maj ~ ~" # s "superpiano" # gain 0.9 # pan 0.4,
+ > s "[bd,clap sd bd sd]"
+ > ] # cps (90/60/4)
+-}
press :: Pattern a -> Pattern a
press = _pressBy 0.5
--- | Like @press@, but allows you to specify the amount in which each event is shifted. @pressBy 0.5@ is the same as @press@, while @pressBy (1/3)@ shifts each event by a third of its arc.
+{-| Like @press@, but allows you to specify the amount in which each event is
+ shifted as a float from 0 to 1 (exclusive).
+
+ @pressBy 0.5@ is the same as @press@, while @pressBy (1/3)@ shifts each event
+ by a third of its arc.
+
+ You can pattern the displacement to create interesting rhythmic effects:
+
+ > d1 $ stack [
+ > s "bd sd bd sd",
+ > pressBy "<0 0.5>" $ s "co:2*4"
+ > ]
+
+ > d1 $ stack [
+ > s "[bd,co sd bd sd]",
+ > pressBy "<0 0.25 0.5 0.75>" $ s "cp"
+ > ]
+-}
pressBy :: Pattern Time -> Pattern a -> Pattern a
pressBy = tParam _pressBy
_pressBy :: Time -> Pattern a -> Pattern a
_pressBy r pat = squeezeJoin $ (compressTo (r,1) . pure) <$> pat
--- | Uses the first (binary) pattern to switch between the following
--- two patterns. The resulting structure comes from the source patterns, not the
--- binary pattern. See also @stitch@.
+{-
+ Uses the first (binary) pattern to switch between the following
+ two patterns. The resulting structure comes from the source patterns, not the
+ binary pattern. See also `stitch`.
+
+ The following will play the first pattern for the first half of a cycle, and
+ the second pattern for the other half; it combines two patterns of strings and
+ passes the result to the sound function:
+
+ > d1 $ sound (sew "t f" "bd*8" "cp*8")
+
+ It’s possible to sew together two control patterns:
+
+ > d1 $ sew "t "
+ > (n "0 .. 15" # s "future")
+ > (s "cp:3*16" # speed saw + 1.2)
+
+ You can also use Euclidean rhythm syntax in the boolean sequence:
+
+ > d1 $ sew "t(11,16)"
+ > (n "0 .. 15" # s "future")
+ > (s "cp:3*16" # speed sine + 1.5)
+-}
sew :: Pattern Bool -> Pattern a -> Pattern a -> Pattern a
sew pb a b = overlay (mask pb a) (mask (inv pb) b)
--- | Uses the first (binary) pattern to switch between the following
--- two patterns. The resulting structure comes from the binary
--- pattern, not the source patterns. See also @sew@.
+{-| Uses the first (binary) pattern to switch between the following
+ two patterns. The resulting structure comes from the binary
+ pattern, not the source patterns. (In 'sew', by contrast, the resulting structure comes from the source patterns.)
+
+ The following uses a euclidean pattern to control CC0:
+
+ > d1 $ ccv (stitch "t(7,16)" 127 0) # ccn 0 # "midi"
+-}
stitch :: Pattern Bool -> Pattern a -> Pattern a -> Pattern a
stitch pb a b = overlay (struct pb a) (struct (inv pb) b)
@@ -1773,34 +2196,27 @@ while b f pat = sew b (f pat) pat
@stutter n t pat@ repeats each event in @pat@ @n@ times, separated by @t@ time (in fractions of a cycle).
It is like 'Sound.Tidal.Control.echo' that doesn't reduce the volume, or 'ply' if you controlled the timing.
-@
-d1 $ stutter 4 (1/16) $ s "bd cp"
-@
+> d1 $ stutter 4 (1/16) $ s "bd cp"
is functionally equivalent to
-@
-d1 $ stut 4 1 (1/16) $ s "bd cp"
-@
+
+> d1 $ stut 4 1 (1/16) $ s "bd cp"
-}
stutter :: Integral i => i -> Time -> Pattern a -> Pattern a
stutter n t p = stack $ map (\i -> (t * fromIntegral i) `rotR` p) [0 .. (n-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:
+{- | 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) $ striateBy 32 (1/16) $ sound "bev"
-@
+ > d1 $ slow 32 $ jux (rev) $ striateBy 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:
+ When passing pattern transforms to functions like @jux@ and 'every',
+ it's possible to chain multiple transforms together with `.` (function
+ composition). 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) $ striateBy 32 (1/16) $ sound "bev"
-@
+ > d1 $ slow 32 $ jux ((# speed "0.5") . rev) $ striateBy 32 (1/16) $ sound "bev"
-}
jux
:: (Pattern ValueMap -> Pattern ValueMap)
@@ -1817,26 +2233,27 @@ juxcut' :: [t -> Pattern ValueMap] -> t -> Pattern ValueMap
juxcut' fs p = stack $ map (\n -> ((fs !! n) p |+ P.cut (pure $ 1-n)) # P.pan (pure $ fromIntegral n / fromIntegral l)) [0 .. l-1]
where l = length fs
-{- | 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:
+{- | In addition to `jux`, `jux'` allows using a list of pattern
+ transformations. Resulting patterns from each transformation will be spread via
+ pan from left to right.
-@
-d1 $ jux' [iter 4, chop 16, id, rev, palindrome] $ sound "bd sn"
-@
+ For example, the following 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 the chopped and the reversed version will appear mid left and mid
+ right respectively.
-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.
+ > d1 $ jux' [iter 4, chop 16, id, rev, palindrome] $ sound "bd sn"
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",
- ]
+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"
+ ]
@
-}
@@ -1844,7 +2261,7 @@ jux' :: [t -> Pattern ValueMap] -> t -> Pattern ValueMap
jux' fs p = stack $ map (\n -> (fs !! n) p |+ P.pan (pure $ fromIntegral n / fromIntegral l)) [0 .. l-1]
where l = length fs
--- | Multichannel variant of `jux`, _not sure what it does_
+-- | Multichannel variant of `jux`, /not sure what it does/
jux4
:: (Pattern ValueMap -> Pattern ValueMap)
-> Pattern ValueMap -> Pattern ValueMap
@@ -1853,13 +2270,11 @@ jux4 f p = stack [p # P.pan (pure (5/8)), f $ p # P.pan (pure (1/8))]
{- |
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`
+bit much, especially when listening on headphones. The variant @juxBy@
has an additional parameter, which brings the channel closer to the
centre. For example:
-@
-d1 $ juxBy 0.5 (density 2) $ sound "bd sn:1"
-@
+> d1 $ juxBy 0.5 (fast 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.
@@ -1887,10 +2302,12 @@ create a pattern of strings corresponding to the sample at each
name-index pair.
An example:
-@samples "jvbass [~ latibro] [jvbass [latibro jvbass]]" ((1%2) `rotL` slow 6 "[1 6 8 7 3]")@
+
+> samples "jvbass [~ latibro] [jvbass [latibro jvbass]]"
+> ((1%2) `rotL` slow 6 "[1 6 8 7 3]")
The type signature is more general here, but you can consider this
-to be a function of type @Pattern String -> Pattern Int -> Pattern String.
+to be a function of type @Pattern String -> Pattern Int -> Pattern String@.
@samples = liftA2 pick@
-}
@@ -1939,10 +2356,13 @@ cross f p p' = Pattern $ \t -> concat [filter flt $ arc p t,
{- | `range` will take a pattern which goes from 0 to 1 (like `sine`), and range it to a different range - between the first and second arguments. In the below example, `range 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 $ range 1 1.5 sine1)
-@
+> d1 $ jux (iter 4) $ sound "arpy arpy:2*2"
+> |+ speed (slow 4 $ range 1 1.5 sine1)
+
+The above is equivalent to:
+
+> d1 $ jux (iter 4) $ sound "arpy arpy:2*2"
+> |+ speed (slow 4 $ sine1 * 0.5 + 1)
-}
range :: Num a => Pattern a -> Pattern a -> Pattern a -> Pattern a
range fromP toP p = (\from to v -> ((v * (to-from)) + from)) <$> fromP *> toP *> p
@@ -1951,10 +2371,35 @@ _range :: (Functor f, Num b) => b -> b -> f b -> f b
_range from to p = (+ from) . (* (to-from)) <$> p
{- | `rangex` is an exponential version of `range`, good for using with
-frequencies. Do *not* use negative numbers or zero as arguments! -}
+frequencies. For example, @range 20 2000 "0.5"@ will give @1010@ - halfway
+between @20@ and @2000@. But @rangex 20 2000 0.5@ will give @200@ - halfway
+between on a logarithmic scale. This usually sounds better if you’re using the
+numbers as pitch frequencies. Since rangex uses logarithms, don’t try to scale
+things to zero or less.
+-}
rangex :: (Functor f, Floating b) => b -> b -> f b -> f b
rangex from to p = exp <$> _range (log from) (log to) p
+{-|
+ @off@ is similar to 'superimpose', in that it applies a function to a pattern
+ and layers up the results on top of the original pattern. The difference
+ is that @off@ takes an extra pattern being a time (in cycles) to shift the
+ transformed version of the pattern by.
+
+ The following plays a pattern on top of itself, but offset by an eighth of a
+ cycle, with a distorting bitcrush effect applied:
+
+ > d1 $ off 0.125 (# crush 2) $ sound "bd [~ sn:2] mt lt*2"
+
+ The following makes arpeggios by adding offset patterns that are shifted up
+ the scale:
+
+ > d1 $ slow 2
+ > $ n (off 0.25 (+12)
+ > $ off 0.125 (+7)
+ > $ slow 2 "c(3,8) a(3,8,2) f(3,8) e(3,8,4)")
+ > # sound "superpiano"
+-}
off :: Pattern Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
off tp f p = innerJoin $ (\tv -> _off tv f p) <$> tp
@@ -1964,17 +2409,42 @@ _off t f p = superimpose (f . (t `rotR`)) p
offadd :: Num a => Pattern Time -> Pattern a -> Pattern a -> Pattern a
offadd tp pn p = off tp (+pn) p
--- | Step sequencing
+{- |
+ @step@ acts as a kind of simple step-sequencer using strings. For example,
+ @step "sn" "x x 12"@ is equivalent to the pattern of strings given by @"sn ~
+ sn ~ sn:1 sn:2 ~"@. @step@ substitutes the given string for each @x@, for each number
+ it substitutes the string followed by a colon and the number, and for everything
+ else it puts in a rest.
+
+ In other words, @step@ generates a pattern of strings in exactly the syntax you’d want for selecting samples and that can be fed directly into the 's' function.
+
+ > d1 $ s (step "sn" "x x 12 ")
+-}
step :: String -> String -> Pattern String
step s cs = fastcat $ map f cs
where f c | c == 'x' = pure s
| isDigit c = pure $ s ++ ":" ++ [c]
| otherwise = silence
+{- | @steps@ is like @step@ but it takes a list of pairs, like step would, and
+ it plays them all simultaneously.
+
+ > d1 $ s (steps [("cp","x x x x x x"),("bd", "xxxx")])
+-}
steps :: [(String, String)] -> Pattern String
steps = stack . map (uncurry step)
--- | 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...@
+ For example,
+
+ > d1 $ s (step' ["superpiano","supermandolin"] "0 1 000 1")
+ > # sustain 4 # n 0
+
+ is equivalent to
+
+ > d1 $ s "superpiano ~ supermandolin ~ superpiano!3 ~ supermandolin"
+ > # sustain 4 # n 0
+-}
step' :: [String] -> String -> Pattern String
step' ss cs = fastcat $ map f cs
where f c | c == 'x' = pure $ head ss
@@ -1986,19 +2456,36 @@ step' ss cs = fastcat $ map f cs
ghost'' :: Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
ghost'' = ghostWith
--- | Like 'ghost'', but a user-supplied function describes how to alter the pattern.
+{-| Like 'ghost'', but a user-supplied function describes how to alter the pattern.
+
+ In this example, ghost notes are applied to the snare hit, but these notes will
+ be louder, not quieter, and the sample will have its beginning slightly cut:
+
+ > d1 $ slow 2
+ > $ ghostWith (1/16) ((|*| gain 1.1) . (|> begin 0.05))
+ > $ sound "sn"
+
+-}
ghostWith :: Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
ghostWith a f p = superimpose (((a*2.5) `rotR`) . f) $ superimpose (((a*1.5) `rotR`) . f) p
{-
@ghost' t pat@ Adds quieter, pitch-shifted, copies of an event @t@ cycles after events in @pat@, emulating ghost notes that are common in drumming patterns.
+
+The following creates a kick snare pattern with ghost notes applied to the snare hit:
+
+> d1 $ stack [ ghost' 0.125 $ sound "~ sn", sound "bd*2 [~ bd]" ]
-}
ghost' :: Time -> Pattern ValueMap -> Pattern ValueMap
ghost' a p = ghostWith a ((|*| P.gain (pure 0.7)) . (|> P.end (pure 0.2)) . (|*| P.speed (pure 1.25))) p
-{-| As 'ghost', but with the copies set to appear one-eighth of a cycle afterwards.
+{-| As 'ghost'', but with the copies set to appear one-eighth of a cycle afterwards.
@ghost = ghost' 0.125@
+
+The following creates a kick snare pattern with ghost notes applied to the snare hit:
+
+> d1 $ stack [ ghost $ sound "~ sn", sound "bd*2 [~ bd]" ]
-}
ghost :: Pattern ValueMap -> Pattern ValueMap
ghost = ghost' 0.125
@@ -2022,37 +2509,68 @@ tabby nInt p p' = stack [maskedWarp,
maskedWeft = mask (every 2 rev $ _fast (n % 2) $ fastCat [silence, pure True]) weftP
maskedWarp = mask (every 2 rev $ _fast (n % 2) $ fastCat [pure True, silence]) warpP
--- | chooses between a list of patterns, using a pattern of floats (from 0-1)
+-- | Chooses from a list of patterns, using a pattern of floats (from 0 to 1).
select :: Pattern Double -> [Pattern a] -> Pattern a
select = tParam _select
_select :: Double -> [Pattern a] -> Pattern a
_select f ps = ps !! floor (max 0 (min 1 f) * fromIntegral (length ps - 1))
--- | chooses between a list of functions, using a pattern of floats (from 0-1)
+-- | Chooses from a list of functions, using a pattern of floats (from 0 to 1).
selectF :: Pattern Double -> [Pattern a -> Pattern a] -> Pattern a -> Pattern a
selectF pf ps p = innerJoin $ (\f -> _selectF f ps p) <$> pf
_selectF :: Double -> [Pattern a -> Pattern a] -> Pattern a -> Pattern a
_selectF f ps p = (ps !! floor (max 0 (min 0.999999 f) * fromIntegral (length ps))) p
--- | chooses between a list of functions, using a pattern of integers
+-- | Chooses from a list of functions, using a pattern of integers.
pickF :: Pattern Int -> [Pattern a -> Pattern a] -> Pattern a -> Pattern a
pickF pInt fs pat = innerJoin $ (\i -> _pickF i fs pat) <$> pInt
_pickF :: Int -> [Pattern a -> Pattern a] -> Pattern a -> Pattern a
_pickF i fs p = (fs !!! i) p
--- | @contrast p f f' p'@ splits the control pattern @p'@ in two, applying
--- the function @f@ to one and @f'@ to the other. This depends on
--- whether events in it contains values matching with those in @p@.
--- For example in @contrast (# crush 3) (# vowel "a") (n "1") $ n "0 1" # s "bd sn" # speed 3@,
--- the first event will have the vowel effect applied and the second
--- will have the crush applied.
+{- | @contrast f f' p p'@ splits the control pattern @p'@ in two, applying
+ the function @f@ to one and @f'@ to the other. This depends on
+ whether events in @p'@ contain values matching with those in @p@.
+ For example, in
+
+ > contrast (# crush 3) (# vowel "a") (n "1") $ n "0 1" # s "bd sn" # speed 3
+
+ the first event will have the vowel effect applied and the second will have
+ the crush applied.
+
+ @contrast@ is like an if-else-statement over patterns. For @contrast t f p@
+ you can think of @t@ as the true branch, @f@ as the false branch, and @p@ as
+ the test.
+
+ You can use any control pattern as a test of equality, e.g., @n "<0 1>", speed
+ "0.5"@, or things like that. This lets you choose specific properties of the
+ pattern you’re transforming for testing, like in the following example,
+
+ > d1 $ contrast (|+ n 12) (|- n 12) (n "c") $ n (run 4) # s "superpiano"
+
+ where every note that isn’t middle-c will be shifted down an octave but
+ middle-c will be shifted up to c5.
+
+ Since the test given to contrast is also a pattern, you can do things like have
+ it alternate between options:
+
+ > d1 $ contrast (|+ n 12) (|- n 12) (s "")
+ > $ s "superpiano superchip" # n 0
+
+ If you listen to this you’ll hear that which instrument is shifted up and which
+ instrument is shifted down alternates between cycles.
+-}
contrast :: (ControlPattern -> ControlPattern) -> (ControlPattern -> ControlPattern)
-> ControlPattern -> ControlPattern -> ControlPattern
contrast = contrastBy (==)
+{-|
+ @contrastBy@ is contrastBy is the general version of 'contrast', in which you can specify an abritrary boolean function that will be used to compare the control patterns.
+
+ > d2 $ contrastBy (>=) (|+ n 12) (|- n 12) (n "2") $ n "0 1 2 [3 4]" # s "superpiano"
+-}
contrastBy :: (a -> Value -> Bool)
-> (ControlPattern -> Pattern b)
-> (ControlPattern -> Pattern b)
@@ -2079,15 +2597,45 @@ contrastRange = contrastBy f
f (VS s, VS e) (VS v) = v == s && v == e
f _ _ = False
--- | Like @contrast@, but one function is given, and applied to events with matching controls.
+{- |
+ The @fix@ function applies another function to matching events in a pattern of
+ controls. @fix@ is 'contrast' where the false-branching function is set to the
+ identity 'id'. It is like 'contrast', but one function is given and applied to
+ events with matching controls.
+
+ For example, the following only adds the 'crush' control when the @n@ control
+ is set to either 1 or 4:
+
+ > d1 $ slow 2
+ > $ fix (# crush 3) (n "[1,4]")
+ > $ n "0 1 2 3 4 5 6"
+ > # sound "arpy"
+
+ You can be quite specific; for example, the following applies the function
+ @'hurry' 2@ to sample 1 of the drum sample set, and leaves the rest as they are:
+
+ > fix (hurry 2) (s "drum" # n "1")
+-}
fix :: (ControlPattern -> ControlPattern) -> ControlPattern -> ControlPattern -> ControlPattern
fix f = contrast f id
--- | Like @contrast@, but one function is given, and applied to events
--- with controls which don't match.
+-- | Like 'contrast', but one function is given, and applied to events with
+-- controls which don't match. @unfix@ is 'fix' but only applies when the
+-- testing pattern is /not/ a match.
unfix :: (ControlPattern -> ControlPattern) -> ControlPattern -> ControlPattern -> ControlPattern
unfix = contrast id
+{-|
+ The @fixRange@ function isn’t very user-friendly at the moment, but you can
+ create a @fix@ variant with a range condition. Any value of a 'ControlPattern'
+ wich matches the values will apply the passed function.
+
+ > d1 $ ( fixRange ( (# distort 1) . (# gain 0.8) )
+ > ( pure $ Map.singleton "note" ((VN 0, VN 7)) )
+ > )
+ > $ s "superpiano"
+ > <| note "1 12 7 11"
+-}
fixRange :: (ControlPattern -> Pattern ValueMap)
-> Pattern (Map.Map String (Value, Value))
-> ControlPattern
@@ -2100,8 +2648,27 @@ unfixRange :: (ControlPattern -> Pattern ValueMap)
-> ControlPattern
unfixRange = contrastRange id
--- | Limits values in a Pattern (or other Functor) to n equally spaced
--- divisions of 1.
+{- | @quantise@ limits values in a Pattern (or other Functor) to @n@ equally spaced
+divisions of 1.
+
+It is useful for rounding a collection of numbers to some particular base
+fraction. For example,
+
+> quantise 5 [0, 1.3 ,2.6,3.2,4.7,5]
+
+It will round all the values to the nearest @(1/5)=0.2@ and thus will output
+the list @[0.0,1.2,2.6,3.2,4.8,5.0]@. You can use this function to force a
+continuous pattern like sine into specific values. In the following example:
+
+> d1 $ s "superchip*8" # n (quantise 1 $ range (-10) (10) $ slow 8 $ cosine)
+> # release (quantise 5 $ slow 8 $ sine + 0.1)
+
+all the releases selected be rounded to the nearest @0.1@ and the notes selected
+to the nearest @1@.
+
+@quantise@ with fractional inputs does the consistent thing: @quantise 0.5@
+rounds values to the nearest @2@, @quantise 0.25@ rounds the nearest @4@, etc.
+-}
quantise :: (Functor f, RealFrac b) => b -> f b -> f b
quantise n = fmap ((/n) . (fromIntegral :: RealFrac b => Int -> b) . round . (*n))
@@ -2140,12 +2707,9 @@ mono p = Pattern $ \(State a cm) -> flatten $ query p (State a cm) where
{-|
@smooth@ receives a pattern of numbers and linearly goes from one to the next, passing through all of them. As time is cycle-based, after reaching the last number in the pattern, it will smoothly go to the first one again.
-@
- d1 $ sound "bd*4" # pan (slow 4 $ smooth "0 1 0.5 1")
-@
+> d1 $ sound "bd*4" # pan (slow 4 $ smooth "0 1 0.5 1")
This sound will pan gradually from left to right, then to the center, then to the right again, and finally comes back to the left.
-
-}
-- serialize the given pattern
@@ -2190,17 +2754,24 @@ swap things p = filterJust $ (`lookup` things) <$> p
it will then transform the pattern and combine it with the last transformation until the depth is reached.
This is like putting an effect (like a filter) in the feedback of a delay line; each echo is more affected.
- @d1 $ note (scale "hexDorian" $ snowball 8 (+) (slow 2 . rev) "0 ~ . -1 . 5 3 4 . ~ -2") # s "gtr"@
+ > d1 $ note ( scale "hexDorian"
+ > $ snowball 8 (+) (slow 2 . rev) "0 ~ . -1 . 5 3 4 . ~ -2"
+ > )
+ > # s "gtr"
-}
snowball :: Int -> (Pattern a -> Pattern a -> Pattern a) -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
snowball depth combinationFunction f pattern = cat $ take depth $ scanl combinationFunction pattern $ drop 1 $ iterate f pattern
-{- @soak@ |
- applies a function to a pattern and cats the resulting pattern,
- then continues applying the function until the depth is reached
- this can be used to create a pattern that wanders away from
- the original pattern by continually adding random numbers
- d1 $ note (scale "hexDorian" mutateBy (+ (range -1 1 $ irand 2)) 8 $ "0 1 . 2 3 4") # s "gtr"
+{- |
+ Applies a function to a pattern and cats the resulting pattern, then continues
+ applying the function until the depth is reached this can be used to create
+ a pattern that wanders away from the original pattern by continually adding
+ random numbers.
+
+ > d1 $ note ( scale "hexDorian" mutateBy (+ (range -1 1 $ irand 2)) 8
+ > $ "0 1 . 2 3 4"
+ > )
+ > # s "gtr"
-}
soak :: Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
soak depth f pattern = cat $ take depth $ iterate f pattern
@@ -2223,6 +2794,21 @@ deconstruct n p = intercalate " " $ map showStep $ toList p
{- | @bite n ipat pat@ slices a pattern @pat@ into @n@ pieces, then uses the
@ipat@ pattern of integers to index into those slices. So @bite 4 "0 2*2" (run
8)@ is the same as @"[0 1] [4 5]*2"@.
+
+ I.e., it allows you to slice each cycle into a given number of equal sized
+ bits, and then pattern those bits by number. It’s similar to @slice@, but is
+ for slicing up patterns, rather than samples. The following slices the pattern
+ into four bits, and then plays those bits in turn:
+
+ > d1 $ bite 4 "0 1 2 3" $ n "0 .. 7" # sound "arpy"
+
+ Of course that doesn’t actually change anything, but then you can reorder those bits:
+
+ > d1 $ bite 4 "2 0 1 3" $ n "0 .. 7" # sound "arpy"
+
+ The slices bits of pattern will be squeezed or contracted to fit:
+
+ > d1 $ bite 4 "2 [0 3] 1*4 1" $ n "0 .. 7" # sound "arpy"
-}
bite :: Pattern Int -> Pattern Int -> Pattern a -> Pattern a
bite npat ipat pat = innerJoin $ (\n -> _bite n ipat pat) <$> npat
@@ -2232,8 +2818,7 @@ _bite n ipat pat = squeezeJoin $ zoompat <$> ipat
where zoompat i = zoom (i'/(fromIntegral n), (i'+1)/(fromIntegral n)) pat
where i' = fromIntegral $ i `mod` n
-{- | @squeeze@ uses a pattern of integers to index into a list of patterns.
--}
+-- | Chooses from a list of patterns, using a pattern of integers.
squeeze :: Pattern Int -> [Pattern a] -> Pattern a
squeeze _ [] = silence
squeeze ipat pats = squeezeJoin $ (pats !!!) <$> ipat
@@ -2257,7 +2842,11 @@ _chew n ipat pat = (squeezeJoinUp $ zoompat <$> ipat) |/ P.speed (pure $ fromInt
where i' = fromIntegral $ i `mod` n
{-|
-@chew@ works the same as 'bite', but speeds up\/slows down playback of sounds as well as squeezing/contracting the slices of the provided pattern.
+ @chew@ works the same as 'bite', but speeds up\/slows down playback of sounds as
+ well as squeezing\/contracting the slices of the provided pattern. Compare:
+
+ > d1 $ 'bite' 4 "0 1*2 2*2 [~ 3]" $ n "0 .. 7" # sound "drum"
+ > d1 $ chew 4 "0 1*2 2*2 [~ 3]" $ n "0 .. 7" # sound "drum"
-}
-- TODO maybe _chew could pattern the first parameter directly..
@@ -2282,18 +2871,26 @@ binary = binaryN 8
ascii :: Pattern String -> Pattern Bool
ascii p = squeezeJoin $ (listToPat . concatMap (__binary 8 . ord)) <$> p
--- | Given a start point and a duration (both specified in cycles), this
--- generates a control pattern that makes a sound begin at the start
--- point and last the duration.
---
--- @grain s d = 'Sound.Tidal.Params.begin' s # 'Sound.Tidal.Params.end' (s+d)@
+{- | Given a start point and a duration (both specified in cycles), this
+ generates a control pattern that makes a sound begin at the start
+ point and last the duration.
+
+ The following are equivalent:
+
+ > d1 $ slow 2 $ s "bev" # grain 0.2 0.1 # legato 1
+ > d1 $ slow 2 $ s "bev" # begin 0.2 # end 0.3 # legato 1
+
+ @grain@ is defined as:
+
+ > grain s d = 'Sound.Tidal.Params.begin' s # 'Sound.Tidal.Params.end' (s+d)
+-}
grain :: Pattern Double -> Pattern Double -> ControlPattern
grain s w = P.begin b # P.end e
where b = s
e = s + w
-- | For specifying a boolean pattern according to a list of offsets
--- (aka inter-onset intervals). For example `necklace 12 [4,2]` is
+-- (aka inter-onset intervals). For example @necklace 12 [4,2]@ is
-- the same as "t f f f t f t f f f t f". That is, 12 steps per cycle,
-- with true values alternating between every 4 and every 2 steps.
necklace :: Rational -> [Int] -> Pattern Bool
diff --git a/src/Sound/Tidal/Version.hs b/src/Sound/Tidal/Version.hs
index 02a93fb00..cbe3c0748 100644
--- a/src/Sound/Tidal/Version.hs
+++ b/src/Sound/Tidal/Version.hs
@@ -21,7 +21,7 @@ import Paths_tidal
-}
tidal_version :: String
-tidal_version = "1.9.4"
+tidal_version = "1.9.5"
tidal_status :: IO ()
tidal_status = tidal_status_string >>= putStrLn
diff --git a/stack.yaml b/stack.yaml
index b12824c46..7962e96b1 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -1,4 +1,4 @@
-resolver: lts-20.5
+resolver: lts-22.8
packages:
- '.'
@@ -8,6 +8,6 @@ packages:
extra-deps:
- hosc-0.20
- - haskellish-0.3.2.1
+ - haskellish-0.3.2.2
diff --git a/test/dontcrash.hs b/test/dontcrash.hs
index 166ebd956..e6194110b 100644
--- a/test/dontcrash.hs
+++ b/test/dontcrash.hs
@@ -9,7 +9,7 @@ import Sound.Tidal.Context
main = do
- tidal <- startTidal (superdirtTarget {oLatency = 0.1, oAddress = "127.0.0.1", oPort = 57120}) (defaultConfig {cFrameTimespan = 1/20})
+ tidal <- startTidal (superdirtTarget {oLatency = 0.1, oAddress = "127.0.0.1", oPort = 57120}) (defaultConfig)
let p = streamReplace tidal
d1 = p 1 . (|< orbit 0)
diff --git a/tidal-link/link/.appveyor.yml b/tidal-link/link/.appveyor.yml
index 27214e28d..aff8de98c 100644
--- a/tidal-link/link/.appveyor.yml
+++ b/tidal-link/link/.appveyor.yml
@@ -12,15 +12,15 @@ environment:
- APPVEYOR_BUILD_WORKER_IMAGE: macos-catalina
CONFIGURATION: Release
XCODE_VERSION: 11.7
- - APPVEYOR_BUILD_WORKER_IMAGE: macos-catalina
+ - APPVEYOR_BUILD_WORKER_IMAGE: macos-bigsur
CONFIGURATION: Debug
- XCODE_VERSION: 12.3
+ XCODE_VERSION: 12.5.1
- APPVEYOR_BUILD_WORKER_IMAGE: macos-monterey
CONFIGURATION: Release
- XCODE_VERSION: 12.5.1
+ XCODE_VERSION: 13.4.1
- APPVEYOR_BUILD_WORKER_IMAGE: macos-monterey
CONFIGURATION: Release
- XCODE_VERSION: 13.2.1
+ XCODE_VERSION: 14.1
- APPVEYOR_BUILD_WORKER_IMAGE: Ubuntu2004
AUDIO_DRIVER: Jack
CONFIGURATION: Debug
@@ -52,20 +52,10 @@ environment:
GENERATOR: Ninja
CXX: g++-7
- APPVEYOR_BUILD_WORKER_IMAGE: Visual Studio 2015
- AUDIO_DRIVER: Asio
- THREAD_DESCRIPTION: OFF
- CONFIGURATION: Release
- GENERATOR: Visual Studio 14 2015
- - APPVEYOR_BUILD_WORKER_IMAGE: Visual Studio 2015
- AUDIO_DRIVER: Asio
+ AUDIO_DRIVER: Wasapi
THREAD_DESCRIPTION: OFF
CONFIGURATION: Debug
GENERATOR: Visual Studio 14 2015 Win64
- - APPVEYOR_BUILD_WORKER_IMAGE: Visual Studio 2015
- AUDIO_DRIVER: Asio
- THREAD_DESCRIPTION: OFF
- CONFIGURATION: Release
- GENERATOR: Visual Studio 14 2015 Win64
- APPVEYOR_BUILD_WORKER_IMAGE: Visual Studio 2015
AUDIO_DRIVER: Wasapi
THREAD_DESCRIPTION: OFF
@@ -88,7 +78,7 @@ environment:
GENERATOR: Visual Studio 17 2022
- APPVEYOR_BUILD_WORKER_IMAGE: Ubuntu2004
ESP_IDF: true
- IDF_RELEASE: v4.3.1
+ IDF_RELEASE: v5.1.1
- APPVEYOR_BUILD_WORKER_IMAGE: Ubuntu2004
FORMATTING: true
@@ -100,6 +90,7 @@ for:
only:
- APPVEYOR_BUILD_WORKER_IMAGE: macos-mojave
- APPVEYOR_BUILD_WORKER_IMAGE: macos-catalina
+ - APPVEYOR_BUILD_WORKER_IMAGE: macos-bigsur
- APPVEYOR_BUILD_WORKER_IMAGE: macos-monterey
build_script:
- sudo xcode-select -s /Applications/Xcode-$XCODE_VERSION.app
@@ -114,7 +105,6 @@ for:
- GENERATOR: Ninja
install:
- git submodule update --init --recursive
- - sudo apt-get update
- sudo apt-get install -y libjack-dev portaudio19-dev valgrind
build_script:
- python3 ci/configure.py --audio-driver $AUDIO_DRIVER --generator "$GENERATOR" --configuration $CONFIGURATION
@@ -129,6 +119,7 @@ for:
- APPVEYOR_BUILD_WORKER_IMAGE: Visual Studio 2019
- APPVEYOR_BUILD_WORKER_IMAGE: Visual Studio 2022
build_script:
+ - py -3 -m pip install setuptools
- py -3 ci/configure.py --audio-driver %AUDIO_DRIVER% --thread-description %THREAD_DESCRIPTION% --generator "%GENERATOR%" --flags="-DCMAKE_SYSTEM_VERSION=10.0.18362.0"
- py -3 ci/build.py --configuration %CONFIGURATION%
test_script:
diff --git a/tidal-link/link/Ableton Link Guidelines.pdf b/tidal-link/link/Ableton Link Guidelines.pdf
new file mode 100644
index 000000000..09cf86ae3
Binary files /dev/null and b/tidal-link/link/Ableton Link Guidelines.pdf differ
diff --git a/tidal-link/link/AbletonLinkConfig.cmake b/tidal-link/link/AbletonLinkConfig.cmake
index 43b66e7d3..b036deb17 100644
--- a/tidal-link/link/AbletonLinkConfig.cmake
+++ b/tidal-link/link/AbletonLinkConfig.cmake
@@ -36,6 +36,11 @@ elseif(CMAKE_SYSTEM_NAME MATCHES "Linux|kFreeBSD|GNU")
INTERFACE_COMPILE_DEFINITIONS
LINK_PLATFORM_LINUX=1
)
+ set_property(TARGET Ableton::Link APPEND PROPERTY
+ INTERFACE_LINK_LIBRARIES
+ atomic
+ pthread
+ )
endif()
include(${CMAKE_CURRENT_LIST_DIR}/cmake_include/AsioStandaloneConfig.cmake)
diff --git a/tidal-link/link/CMakeLists.txt b/tidal-link/link/CMakeLists.txt
index 5924722da..52187f572 100644
--- a/tidal-link/link/CMakeLists.txt
+++ b/tidal-link/link/CMakeLists.txt
@@ -1,4 +1,4 @@
-cmake_minimum_required(VERSION 3.0)
+cmake_minimum_required(VERSION 3.5)
project(Link)
set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/bin)
@@ -22,6 +22,8 @@ if(WIN32)
option(LINK_BUILD_VLD "Build with VLD support (VLD must be installed separately)" OFF)
endif()
+option(LINK_BUILD_TESTS "Build unit test binaries" ON)
+
# ____ _ _
# | _ \ __ _| |_| |__ ___
# | |_) / _` | __| '_ \/ __|
@@ -36,7 +38,9 @@ include(AbletonLinkConfig.cmake)
include(extensions/abl_link/abl_link.cmake)
add_subdirectory(include)
+if(LINK_BUILD_TESTS)
add_subdirectory(src)
+endif()
add_subdirectory(examples)
add_subdirectory(extensions/abl_link)
diff --git a/tidal-link/link/README.md b/tidal-link/link/README.md
index ee2c6b1d9..094c2f997 100644
--- a/tidal-link/link/README.md
+++ b/tidal-link/link/README.md
@@ -108,7 +108,7 @@ implementations. Please see:
[platforms/darwin/Clock.hpp](include/ableton/platforms/darwin/Clock.hpp)
- Windows clock implementation in
[platforms/windows/Clock.hpp](include/ableton/platforms/windows/Clock.hpp)
-- C++ standard library `std::chrono::high_resolution_clock`-based implementation in
+- C++ standard library `std::chrono::steady_clock`-based implementation in
[platforms/stl/Clock.hpp](include/ableton/platforms/stl/Clock.hpp)
Using the system time correctly in the context of an audio callback gets a little
diff --git a/tidal-link/link/ci/build.py b/tidal-link/link/ci/build.py
old mode 100644
new mode 100755
diff --git a/tidal-link/link/ci/check-formatting.py b/tidal-link/link/ci/check-formatting.py
old mode 100644
new mode 100755
diff --git a/tidal-link/link/ci/configure.py b/tidal-link/link/ci/configure.py
old mode 100644
new mode 100755
diff --git a/tidal-link/link/ci/run-tests.py b/tidal-link/link/ci/run-tests.py
old mode 100644
new mode 100755
diff --git a/tidal-link/link/ci/run_valgrind_tests.sh b/tidal-link/link/ci/run_valgrind_tests.sh
old mode 100644
new mode 100755
diff --git a/tidal-link/link/cmake_include/ConfigureCompileFlags.cmake b/tidal-link/link/cmake_include/ConfigureCompileFlags.cmake
index 63bdfec57..ec6cd55e3 100644
--- a/tidal-link/link/cmake_include/ConfigureCompileFlags.cmake
+++ b/tidal-link/link/cmake_include/ConfigureCompileFlags.cmake
@@ -1,4 +1,4 @@
-cmake_minimum_required(VERSION 3.0)
+cmake_minimum_required(VERSION 3.5)
set(build_flags_COMMON_LIST)
set(build_flags_DEBUG_LIST)
@@ -128,6 +128,8 @@ elseif(${CMAKE_CXX_COMPILER_ID} STREQUAL MSVC)
"/wd4868" # Compiler may not enforce left-to-right evaluation order in braced initializer list
"/wd5026" # Move constructor was implicitly defined as deleted
"/wd5027" # Move assignment operator was implicitly defined as deleted
+ "/wd5262" # implicit fall-through
+ "/wd5264" # 'variable-name': 'const' variable is not used
)
endif()
diff --git a/tidal-link/link/examples/CMakeLists.txt b/tidal-link/link/examples/CMakeLists.txt
index f75b00b1b..775b1dfd0 100644
--- a/tidal-link/link/examples/CMakeLists.txt
+++ b/tidal-link/link/examples/CMakeLists.txt
@@ -1,4 +1,4 @@
-cmake_minimum_required(VERSION 3.0)
+cmake_minimum_required(VERSION 3.5)
project(LinkExamples)
# _ ____ ___ ___
@@ -11,7 +11,7 @@ project(LinkExamples)
if(WIN32)
function(configure_asio asio_sdk_path_OUT)
# ASIO-related path/file variables
- set(asio_download_root "https:/download.steinberg.net/sdk_downloads")
+ set(asio_download_root "https://download.steinberg.net/sdk_downloads")
set(asio_file_name "asiosdk_2.3.3_2019-06-14.zip")
set(asio_dir_name "asiosdk_2.3.3_2019-06-14")
set(asio_working_dir "${CMAKE_BINARY_DIR}/modules")
@@ -96,10 +96,6 @@ source_group("Audio Sources" FILES ${linkhut_audio_SOURCES})
#
function(configure_linkhut_executable target)
- if(CMAKE_SYSTEM_NAME MATCHES "Linux|kFreeBSD|GNU")
- target_link_libraries(${target} atomic pthread)
- endif()
-
target_link_libraries(${target} Ableton::Link)
endfunction()
diff --git a/tidal-link/link/examples/esp32/.gitignore b/tidal-link/link/examples/esp32/.gitignore
index d054d8439..38c3a5f9e 100644
--- a/tidal-link/link/examples/esp32/.gitignore
+++ b/tidal-link/link/examples/esp32/.gitignore
@@ -1,3 +1,4 @@
build
sdkconfig
sdkconfig.old
+managed_components
diff --git a/tidal-link/link/examples/esp32/main/idf_component.yml b/tidal-link/link/examples/esp32/main/idf_component.yml
new file mode 100644
index 000000000..75eccbfe8
--- /dev/null
+++ b/tidal-link/link/examples/esp32/main/idf_component.yml
@@ -0,0 +1,17 @@
+## IDF Component Manager Manifest File
+dependencies:
+ espressif/asio: "*"
+ ## Required IDF version
+ idf:
+ version: ">=4.1.0"
+ # # Put list of dependencies here
+ # # For components maintained by Espressif:
+ # component: "~1.0.0"
+ # # For 3rd party components:
+ # username/component: ">=1.0.0,<2.0.0"
+ # username2/component2:
+ # version: "~1.0.0"
+ # # For transient dependencies `public` flag can be set.
+ # # `public` flag doesn't have an effect dependencies of the `main` component.
+ # # All dependencies of `main` are public by default.
+ # public: true
diff --git a/tidal-link/link/examples/esp32/main/main.cpp b/tidal-link/link/examples/esp32/main/main.cpp
index b44f45923..0a5c56ba2 100644
--- a/tidal-link/link/examples/esp32/main/main.cpp
+++ b/tidal-link/link/examples/esp32/main/main.cpp
@@ -1,6 +1,6 @@
#include
#include
-#include
+#include
#include
#include
#include
@@ -21,38 +21,6 @@ char* if_indextoname(unsigned int ifIndex, char* ifName)
return nullptr;
}
-void IRAM_ATTR timer_group0_isr(void* userParam)
-{
- static BaseType_t xHigherPriorityTaskWoken = pdFALSE;
-
- TIMERG0.int_clr_timers.t0 = 1;
- TIMERG0.hw_timer[0].config.alarm_en = 1;
-
- xSemaphoreGiveFromISR(userParam, &xHigherPriorityTaskWoken);
- if (xHigherPriorityTaskWoken)
- {
- portYIELD_FROM_ISR();
- }
-}
-
-void timerGroup0Init(int timerPeriodUS, void* userParam)
-{
- timer_config_t config = {.alarm_en = TIMER_ALARM_EN,
- .counter_en = TIMER_PAUSE,
- .intr_type = TIMER_INTR_LEVEL,
- .counter_dir = TIMER_COUNT_UP,
- .auto_reload = TIMER_AUTORELOAD_EN,
- .divider = 80};
-
- timer_init(TIMER_GROUP_0, TIMER_0, &config);
- timer_set_counter_value(TIMER_GROUP_0, TIMER_0, 0);
- timer_set_alarm_value(TIMER_GROUP_0, TIMER_0, timerPeriodUS);
- timer_enable_intr(TIMER_GROUP_0, TIMER_0);
- timer_isr_register(TIMER_GROUP_0, TIMER_0, &timer_group0_isr, userParam, 0, nullptr);
-
- timer_start(TIMER_GROUP_0, TIMER_0);
-}
-
void printTask(void* userParam)
{
auto link = static_cast(userParam);
@@ -73,7 +41,6 @@ void printTask(void* userParam)
void tickTask(void* userParam)
{
- SemaphoreHandle_t handle = static_cast(userParam);
ableton::Link link(120.0f);
link.enable(true);
@@ -86,12 +53,10 @@ void tickTask(void* userParam)
while (true)
{
- xSemaphoreTake(handle, portMAX_DELAY);
-
const auto state = link.captureAudioSessionState();
const auto phase = state.phaseAtTime(link.clock().micros(), 1.);
gpio_set_level(LED, fmodf(phase, 1.) < 0.1);
- portYIELD();
+ vTaskDelay(1);
}
}
@@ -102,8 +67,5 @@ extern "C" void app_main()
ESP_ERROR_CHECK(esp_event_loop_create_default());
ESP_ERROR_CHECK(example_connect());
- SemaphoreHandle_t tickSemphr = xSemaphoreCreateBinary();
- timerGroup0Init(100, tickSemphr);
-
- xTaskCreate(tickTask, "tick", 8192, tickSemphr, configMAX_PRIORITIES - 1, nullptr);
+ xTaskCreate(tickTask, "tick", 8192, nullptr, configMAX_PRIORITIES - 1, nullptr);
}
diff --git a/tidal-link/link/examples/esp32/sdkconfig.defaults b/tidal-link/link/examples/esp32/sdkconfig.defaults
index 75ebeae1c..33b93f576 100644
--- a/tidal-link/link/examples/esp32/sdkconfig.defaults
+++ b/tidal-link/link/examples/esp32/sdkconfig.defaults
@@ -1 +1,3 @@
CONFIG_COMPILER_CXX_EXCEPTIONS=y
+CONFIG_PARTITION_TABLE_SINGLE_APP_LARGE=y
+
diff --git a/tidal-link/link/extensions/abl_link/abl_link.cmake b/tidal-link/link/extensions/abl_link/abl_link.cmake
index 00efd1ee2..8e52a063b 100644
--- a/tidal-link/link/extensions/abl_link/abl_link.cmake
+++ b/tidal-link/link/extensions/abl_link/abl_link.cmake
@@ -13,7 +13,3 @@ target_include_directories(abl_link PUBLIC
set_property(TARGET abl_link PROPERTY C_STANDARD 11)
target_link_libraries(abl_link Ableton::Link)
-
-if(CMAKE_SYSTEM_NAME MATCHES "Linux|kFreeBSD|GNU")
- target_link_libraries(abl_link atomic pthread)
-endif()
diff --git a/tidal-link/link/include/CMakeLists.txt b/tidal-link/link/include/CMakeLists.txt
index 1c7b5ed96..2cf37b8f0 100644
--- a/tidal-link/link/include/CMakeLists.txt
+++ b/tidal-link/link/include/CMakeLists.txt
@@ -1,4 +1,4 @@
-cmake_minimum_required(VERSION 3.0)
+cmake_minimum_required(VERSION 3.5)
project(LinkCore)
# ____
@@ -19,6 +19,7 @@ set(link_core_HEADERS
${link_core_DIR}/LinearRegression.hpp
${link_core_DIR}/Measurement.hpp
${link_core_DIR}/MeasurementEndpointV4.hpp
+ ${link_core_DIR}/MeasurementEndpointV6.hpp
${link_core_DIR}/MeasurementService.hpp
${link_core_DIR}/Median.hpp
${link_core_DIR}/NodeId.hpp
@@ -49,8 +50,9 @@ set(link_core_HEADERS
set(link_discovery_DIR ${CMAKE_CURRENT_SOURCE_DIR}/ableton/discovery)
set(link_discovery_HEADERS
+ ${link_discovery_DIR}/AsioTypes.hpp
${link_discovery_DIR}/InterfaceScanner.hpp
- ${link_discovery_DIR}/IpV4Interface.hpp
+ ${link_discovery_DIR}/IpInterface.hpp
${link_discovery_DIR}/MessageTypes.hpp
${link_discovery_DIR}/NetworkByteStreamSerializable.hpp
${link_discovery_DIR}/Payload.hpp
@@ -77,7 +79,6 @@ set(link_platform_HEADERS
${link_platform_DIR}/asio/Context.hpp
${link_platform_DIR}/asio/LockFreeCallbackDispatcher.hpp
${link_platform_DIR}/asio/Socket.hpp
- ${link_platform_DIR}/asio/Util.hpp
)
if(ESP_PLATFORM)
diff --git a/tidal-link/link/include/ableton/Link.ipp b/tidal-link/link/include/ableton/Link.ipp
index f8cbce832..28fb1e471 100644
--- a/tidal-link/link/include/ableton/Link.ipp
+++ b/tidal-link/link/include/ableton/Link.ipp
@@ -225,19 +225,33 @@ inline void BasicLink::SessionState::requestBeatAtTime(
forceBeatAtTime(beat, time, quantum);
}
-template
-inline void BasicLink::SessionState::forceBeatAtTime(
- const double beat, const std::chrono::microseconds time, const double quantum)
+inline void forceBeatAtTimeImpl(link::Timeline& timeline,
+ const link::Beats beat,
+ const std::chrono::microseconds time,
+ const link::Beats quantum)
{
// There are two components to the beat adjustment: a phase shift
// and a beat magnitude adjustment.
- const auto curBeatAtTime = link::Beats{beatAtTime(time, quantum)};
- const auto closestInPhase =
- link::closestPhaseMatch(curBeatAtTime, link::Beats{beat}, link::Beats{quantum});
- mState.timeline = shiftClientTimeline(mState.timeline, closestInPhase - curBeatAtTime);
+ const auto curBeatAtTime = link::toPhaseEncodedBeats(timeline, time, quantum);
+ const auto closestInPhase = link::closestPhaseMatch(curBeatAtTime, beat, quantum);
+ timeline = shiftClientTimeline(timeline, closestInPhase - curBeatAtTime);
// Now adjust the magnitude
- mState.timeline.beatOrigin =
- mState.timeline.beatOrigin + (link::Beats{beat} - closestInPhase);
+ timeline.beatOrigin = timeline.beatOrigin + beat - closestInPhase;
+}
+
+template
+inline void BasicLink::SessionState::forceBeatAtTime(
+ const double beat, std::chrono::microseconds time, const double quantum)
+{
+ forceBeatAtTimeImpl(mState.timeline, link::Beats{beat}, time, link::Beats{quantum});
+
+ // Due to quantization errors the resulting BeatTime at 'time' after forcing can be
+ // bigger than 'beat' which then violates intended behavior of the API and can lead
+ // i.e. to missing a downbeat. Thus we have to shift the timeline forwards.
+ if (beatAtTime(time, quantum) > beat)
+ {
+ forceBeatAtTimeImpl(mState.timeline, link::Beats{beat}, ++time, link::Beats{quantum});
+ }
}
template
diff --git a/tidal-link/link/include/ableton/platforms/asio/Util.hpp b/tidal-link/link/include/ableton/discovery/AsioTypes.hpp
similarity index 61%
rename from tidal-link/link/include/ableton/platforms/asio/Util.hpp
rename to tidal-link/link/include/ableton/discovery/AsioTypes.hpp
index b974c10cc..fe0e9a7a3 100644
--- a/tidal-link/link/include/ableton/platforms/asio/Util.hpp
+++ b/tidal-link/link/include/ableton/discovery/AsioTypes.hpp
@@ -1,4 +1,4 @@
-/* Copyright 2016, Ableton AG, Berlin. All rights reserved.
+/* Copyright 2023, Ableton AG, Berlin. All rights reserved.
*
* This program is free software: you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@@ -19,16 +19,19 @@
#pragma once
-#include
+#include
namespace ableton
{
-namespace platforms
-{
-namespace asio
+namespace discovery
{
-// Utility for making v4 or v6 ip addresses from raw bytes in network byte-order
+using IpAddress = LINK_ASIO_NAMESPACE::ip::address;
+using IpAddressV4 = LINK_ASIO_NAMESPACE::ip::address_v4;
+using IpAddressV6 = LINK_ASIO_NAMESPACE::ip::address_v6;
+using UdpSocket = LINK_ASIO_NAMESPACE::ip::udp::socket;
+using UdpEndpoint = LINK_ASIO_NAMESPACE::ip::udp::endpoint;
+
template
AsioAddrType makeAddress(const char* pAddr)
{
@@ -38,6 +41,14 @@ AsioAddrType makeAddress(const char* pAddr)
return AsioAddrType{bytes};
}
-} // namespace asio
-} // namespace platforms
+template
+AsioAddrType makeAddress(const char* pAddr, uint32_t scopeId)
+{
+ using namespace std;
+ typename AsioAddrType::bytes_type bytes;
+ copy(pAddr, pAddr + bytes.size(), begin(bytes));
+ return AsioAddrType{bytes, scopeId};
+}
+
+} // namespace discovery
} // namespace ableton
diff --git a/tidal-link/link/include/ableton/discovery/InterfaceScanner.hpp b/tidal-link/link/include/ableton/discovery/InterfaceScanner.hpp
index cb3adad56..c3a37f2b9 100644
--- a/tidal-link/link/include/ableton/discovery/InterfaceScanner.hpp
+++ b/tidal-link/link/include/ableton/discovery/InterfaceScanner.hpp
@@ -19,7 +19,7 @@
#pragma once
-#include
+#include
#include
#include
#include
@@ -29,7 +29,7 @@ namespace ableton
namespace discovery
{
-// Callback takes a range of asio::ip:address which is
+// Callback takes a range of IpAddress which is
// guaranteed to be sorted and unique
template
class InterfaceScanner
@@ -64,7 +64,7 @@ class InterfaceScanner
using namespace std;
debug(mIo->log()) << "Scanning network interfaces";
// Rescan the hardware for available network interface addresses
- vector addrs = mIo->scanNetworkInterfaces();
+ vector addrs = mIo->scanNetworkInterfaces();
// Sort and unique them to guarantee consistent comparison
sort(begin(addrs), end(addrs));
addrs.erase(unique(begin(addrs), end(addrs)), end(addrs));
diff --git a/tidal-link/link/include/ableton/discovery/IpV4Interface.hpp b/tidal-link/link/include/ableton/discovery/IpInterface.hpp
similarity index 73%
rename from tidal-link/link/include/ableton/discovery/IpV4Interface.hpp
rename to tidal-link/link/include/ableton/discovery/IpInterface.hpp
index 9967f5125..00a59db4c 100644
--- a/tidal-link/link/include/ableton/discovery/IpV4Interface.hpp
+++ b/tidal-link/link/include/ableton/discovery/IpInterface.hpp
@@ -19,7 +19,7 @@
#pragma once
-#include
+#include
#include
namespace ableton
@@ -27,9 +27,17 @@ namespace ableton
namespace discovery
{
-inline asio::ip::udp::endpoint multicastEndpoint()
+inline UdpEndpoint multicastEndpointV4()
{
- return {asio::ip::address_v4::from_string("224.76.78.75"), 20808};
+ return {IpAddressV4::from_string("224.76.78.75"), 20808};
+}
+
+inline UdpEndpoint multicastEndpointV6(uint64_t scopeId)
+{
+ // This is a non-permanently-assigned link-local multicast address (RFC4291)
+ return {
+ ::LINK_ASIO_NAMESPACE::ip::make_address("ff12::8080%" + std::to_string(scopeId)),
+ 20808};
}
// Type tags for dispatching between unicast and multicast packets
@@ -41,22 +49,22 @@ struct UnicastTag
};
template
-class IpV4Interface
+class IpInterface
{
public:
using Socket = typename util::Injected::type::template Socket;
- IpV4Interface(util::Injected io, const asio::ip::address_v4& addr)
+ IpInterface(util::Injected io, const IpAddress& addr)
: mIo(std::move(io))
, mMulticastReceiveSocket(mIo->template openMulticastSocket(addr))
, mSendSocket(mIo->template openUnicastSocket(addr))
{
}
- IpV4Interface(const IpV4Interface&) = delete;
- IpV4Interface& operator=(const IpV4Interface&) = delete;
+ IpInterface(const IpInterface&) = delete;
+ IpInterface& operator=(const IpInterface&) = delete;
- IpV4Interface(IpV4Interface&& rhs)
+ IpInterface(IpInterface&& rhs)
: mIo(std::move(rhs.mIo))
, mMulticastReceiveSocket(std::move(rhs.mMulticastReceiveSocket))
, mSendSocket(std::move(rhs.mSendSocket))
@@ -65,7 +73,7 @@ class IpV4Interface
std::size_t send(
- const uint8_t* const pData, const size_t numBytes, const asio::ip::udp::endpoint& to)
+ const uint8_t* const pData, const size_t numBytes, const UdpEndpoint& to)
{
return mSendSocket.send(pData, numBytes, to);
}
@@ -83,7 +91,7 @@ class IpV4Interface
SocketReceiver(std::move(handler)));
}
- asio::ip::udp::endpoint endpoint() const
+ UdpEndpoint endpoint() const
{
return mSendSocket.endpoint();
}
@@ -98,8 +106,7 @@ class IpV4Interface
}
template
- void operator()(
- const asio::ip::udp::endpoint& from, const It messageBegin, const It messageEnd)
+ void operator()(const UdpEndpoint& from, const It messageBegin, const It messageEnd)
{
mHandler(Tag{}, from, messageBegin, messageEnd);
}
@@ -113,8 +120,8 @@ class IpV4Interface
};
template
-IpV4Interface makeIpV4Interface(
- util::Injected io, const asio::ip::address_v4& addr)
+IpInterface makeIpInterface(
+ util::Injected io, const IpAddress& addr)
{
return {std::move(io), addr};
}
diff --git a/tidal-link/link/include/ableton/discovery/NetworkByteStreamSerializable.hpp b/tidal-link/link/include/ableton/discovery/NetworkByteStreamSerializable.hpp
index 49a119530..6a39bba92 100644
--- a/tidal-link/link/include/ableton/discovery/NetworkByteStreamSerializable.hpp
+++ b/tidal-link/link/include/ableton/discovery/NetworkByteStreamSerializable.hpp
@@ -19,7 +19,7 @@
#pragma once
-#include
+#include
#if defined(LINK_PLATFORM_MACOSX)
#include
#elif defined(LINK_PLATFORM_LINUX)
diff --git a/tidal-link/link/include/ableton/discovery/Payload.hpp b/tidal-link/link/include/ableton/discovery/Payload.hpp
index 1d48caa7e..f29467288 100644
--- a/tidal-link/link/include/ableton/discovery/Payload.hpp
+++ b/tidal-link/link/include/ableton/discovery/Payload.hpp
@@ -82,6 +82,11 @@ struct PayloadEntry
template
friend It toNetworkByteStream(const PayloadEntry& entry, It out)
{
+ // Don't serialize Entry if its value is of size zero
+ if (sizeInByteStream(entry.value) == 0)
+ {
+ return out;
+ }
return toNetworkByteStream(
entry.value, toNetworkByteStream(entry.header, std::move(out)));
}
diff --git a/tidal-link/link/include/ableton/discovery/PeerGateway.hpp b/tidal-link/link/include/ableton/discovery/PeerGateway.hpp
index db434394c..6b4db27c1 100644
--- a/tidal-link/link/include/ableton/discovery/PeerGateway.hpp
+++ b/tidal-link/link/include/ableton/discovery/PeerGateway.hpp
@@ -216,7 +216,7 @@ PeerGateway makePeerGateway(
// IpV4 gateway types
template
using IpV4Messenger = UdpMessenger<
- IpV4Interface::type&, v1::kMaxMessageSize>,
+ IpInterface::type&, v1::kMaxMessageSize>,
StateQuery,
IoContext>;
@@ -226,11 +226,11 @@ using IpV4Gateway =
PeerObserver,
IoContext>;
-// Factory function to bind a PeerGateway to an IpV4Interface with the given address.
+// Factory function to bind a PeerGateway to an IpInterface with the given address.
template
IpV4Gateway makeIpV4Gateway(
util::Injected io,
- const asio::ip::address_v4& addr,
+ const IpAddress& addr,
util::Injected observer,
NodeState state)
{
@@ -240,7 +240,7 @@ IpV4Gateway makeIpV4Gateway(
const uint8_t ttl = 5;
const uint8_t ttlRatio = 20;
- auto iface = makeIpV4Interface(injectRef(*io), addr);
+ auto iface = makeIpInterface(injectRef(*io), addr);
auto messenger = makeUdpMessenger(
injectVal(std::move(iface)), std::move(state), injectRef(*io), ttl, ttlRatio);
diff --git a/tidal-link/link/include/ableton/discovery/PeerGateways.hpp b/tidal-link/link/include/ableton/discovery/PeerGateways.hpp
index bdefbaef2..959d7fd29 100644
--- a/tidal-link/link/include/ableton/discovery/PeerGateways.hpp
+++ b/tidal-link/link/include/ableton/discovery/PeerGateways.hpp
@@ -19,8 +19,8 @@
#pragma once
+#include
#include
-#include
#include