{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}

module Sound.Tidal.Control where

{-
    Control.hs - Functions which concern control patterns, which are
    patterns of hashmaps, used for synth control values.

    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 <http://www.gnu.org/licenses/>.
-}

import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe)
import Data.Ratio ((%))
import Sound.Tidal.Core
  ( cF,
    cat,
    fastcat,
    overlay,
    sine,
    slowcat,
    stack,
    (#),
    (*|),
    (|*),
    (|>|),
  )
import qualified Sound.Tidal.Params as P
import Sound.Tidal.Pattern
import Sound.Tidal.Pattern.Types (patternTimeID)
import Sound.Tidal.UI (bite, _irand)
import Prelude hiding ((*>), (<*))

-- | `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]"
spin :: Pattern Int -> ControlPattern -> ControlPattern
spin :: Pattern Int -> ControlPattern -> ControlPattern
spin = (Int -> ControlPattern -> ControlPattern)
-> Pattern Int -> ControlPattern -> ControlPattern
forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
patternify Int -> ControlPattern -> ControlPattern
_spin

_spin :: Int -> ControlPattern -> ControlPattern
_spin :: Int -> ControlPattern -> ControlPattern
_spin Int
copies ControlPattern
p =
  [ControlPattern] -> ControlPattern
forall a. [Pattern a] -> Pattern a
stack ([ControlPattern] -> ControlPattern)
-> [ControlPattern] -> ControlPattern
forall a b. (a -> b) -> a -> b
$
    (Int -> ControlPattern) -> [Int] -> [ControlPattern]
forall a b. (a -> b) -> [a] -> [b]
map
      ( \Int
i ->
          let offset :: Time
offset = Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
i Integer -> Integer -> Time
forall a. Integral a => a -> a -> Ratio a
% Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
copies
           in Time
offset
                Time -> ControlPattern -> ControlPattern
forall a. Time -> Pattern a -> Pattern a
`rotL` ControlPattern
p
                # P.pan (pure $ fromRational offset)
      )
      [Int
0 .. (Int
copies Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]

-- | `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.
--
--  Use an integer value to specify how many granules each sample is chopped into:
--
--  > d1 $ chop 16 $ sound "arpy arp feel*4 arpy*4"
--
--  Different values of @chop@ can yield very different results, depending on the
--  samples used:
--
--  > d1 $ chop 16 $ sound (samples "arpy*8" (run 16))
--  > d1 $ chop 32 $ sound (samples "arpy*8" (run 16))
--  > d1 $ chop 256 $ sound "bd*4 [sn cp] [hh future]*2 [cp feel]"
--
--  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 :: Pattern Int -> ControlPattern -> ControlPattern
chop = (Int -> ControlPattern -> ControlPattern)
-> Pattern Int -> ControlPattern -> ControlPattern
forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
patternify Int -> ControlPattern -> ControlPattern
_chop

chopArc :: Arc -> Int -> [Arc]
chopArc :: Arc -> Int -> [Arc]
chopArc (Arc Time
s Time
e) Int
n = (Int -> Arc) -> [Int] -> [Arc]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> Time -> Time -> Arc
forall a. a -> a -> ArcF a
Arc (Time
s Time -> Time -> Time
forall a. Num a => a -> a -> a
+ (Time
e Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time
s) Time -> Time -> Time
forall a. Num a => a -> a -> a
* (Int -> Time
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Time -> Time -> Time
forall a. Fractional a => a -> a -> a
/ Int -> Time
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)) (Time
s Time -> Time -> Time
forall a. Num a => a -> a -> a
+ (Time
e Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time
s) Time -> Time -> Time
forall a. Num a => a -> a -> a
* (Int -> Time
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Time -> Time -> Time
forall a. Fractional a => a -> a -> a
/ Int -> Time
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n))) [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]

_chop :: Int -> ControlPattern -> ControlPattern
_chop :: Int -> ControlPattern -> ControlPattern
_chop Int
n ControlPattern
pat = ControlPattern -> ControlPattern -> ControlPattern
forall a b. Pattern a -> Pattern b -> Pattern b
keepTactus ((Time -> Time) -> ControlPattern -> ControlPattern
forall a. (Time -> Time) -> Pattern a -> Pattern a
withTactus (Time -> Time -> Time
forall a. Num a => a -> a -> a
* Int -> Time
forall a. Real a => a -> Time
toRational Int
n) ControlPattern
pat) (ControlPattern -> ControlPattern)
-> ControlPattern -> ControlPattern
forall a b. (a -> b) -> a -> b
$ Pattern ControlPattern -> ControlPattern
forall a. Pattern (Pattern a) -> Pattern a
squeezeJoin (Pattern ControlPattern -> ControlPattern)
-> Pattern ControlPattern -> ControlPattern
forall a b. (a -> b) -> a -> b
$ ValueMap -> ControlPattern
f (ValueMap -> ControlPattern)
-> ControlPattern -> Pattern ControlPattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ControlPattern
pat
  where
    f :: ValueMap -> ControlPattern
f ValueMap
v = [ControlPattern] -> ControlPattern
forall a. [Pattern a] -> Pattern a
fastcat ([ControlPattern] -> ControlPattern)
-> [ControlPattern] -> ControlPattern
forall a b. (a -> b) -> a -> b
$ ((Double, Double) -> ControlPattern)
-> [(Double, Double)] -> [ControlPattern]
forall a b. (a -> b) -> [a] -> [b]
map (ValueMap -> ControlPattern
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ValueMap -> ControlPattern)
-> ((Double, Double) -> ValueMap)
-> (Double, Double)
-> ControlPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueMap -> (Double, Double) -> ValueMap
rangemap ValueMap
v) [(Double, Double)]
slices
    rangemap :: ValueMap -> (Double, Double) -> ValueMap
rangemap ValueMap
v (Double
b, Double
e) = ValueMap -> ValueMap -> ValueMap
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union (ValueMap -> Maybe ValueMap -> ValueMap
forall a. a -> Maybe a -> a
fromMaybe ((Double, Double) -> ValueMap
forall {k}. (Ord k, IsString k) => (Double, Double) -> Map k Value
makeMap (Double
b, Double
e)) (Maybe ValueMap -> ValueMap) -> Maybe ValueMap -> ValueMap
forall a b. (a -> b) -> a -> b
$ ValueMap -> (Double, Double) -> Maybe ValueMap
merge ValueMap
v (Double
b, Double
e)) ValueMap
v
    merge :: ValueMap -> (Double, Double) -> Maybe ValueMap
    merge :: ValueMap -> (Double, Double) -> Maybe ValueMap
merge ValueMap
v (Double
b, Double
e) = do
      Double
b' <- String -> ValueMap -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
"begin" ValueMap
v Maybe Value -> (Value -> Maybe Double) -> Maybe Double
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Maybe Double
getF
      Double
e' <- String -> ValueMap -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
"end" ValueMap
v Maybe Value -> (Value -> Maybe Double) -> Maybe Double
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Maybe Double
getF
      let d :: Double
d = Double
e' Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
b'
      ValueMap -> Maybe ValueMap
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (ValueMap -> Maybe ValueMap) -> ValueMap -> Maybe ValueMap
forall a b. (a -> b) -> a -> b
$ (Double, Double) -> ValueMap
forall {k}. (Ord k, IsString k) => (Double, Double) -> Map k Value
makeMap (Double
b' Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
d, Double
b' Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
e Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
d)
    makeMap :: (Double, Double) -> Map k Value
makeMap (Double
b, Double
e) = [(k, Value)] -> Map k Value
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(k
"begin", Double -> Value
VF Double
b), (k
"end", Double -> Value
VF (Double -> Value) -> Double -> Value
forall a b. (a -> b) -> a -> b
$ Double
e)]
    slices :: [(Double, Double)]
slices = (Int -> (Double, Double)) -> [Int] -> [(Double, Double)]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> (Int -> Double
forall {a} {a}. (Fractional a, Integral a) => a -> a
frac Int
i, Int -> Double
forall {a} {a}. (Fractional a, Integral a) => a -> a
frac (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
    frac :: a -> a
frac a
i = a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i a -> a -> a
forall a. Fractional a => a -> a -> a
/ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n

-- | 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"
--
-- 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 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"
striate :: Pattern Int -> ControlPattern -> ControlPattern
striate :: Pattern Int -> ControlPattern -> ControlPattern
striate = (Int -> ControlPattern -> ControlPattern)
-> Pattern Int -> ControlPattern -> ControlPattern
forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
patternify Int -> ControlPattern -> ControlPattern
_striate

_striate :: Int -> ControlPattern -> ControlPattern
_striate :: Int -> ControlPattern -> ControlPattern
_striate Int
n ControlPattern
p = ControlPattern -> ControlPattern -> ControlPattern
forall a b. Pattern a -> Pattern b -> Pattern b
keepTactus ((Time -> Time) -> ControlPattern -> ControlPattern
forall a. (Time -> Time) -> Pattern a -> Pattern a
withTactus (Time -> Time -> Time
forall a. Num a => a -> a -> a
* Int -> Time
forall a. Real a => a -> Time
toRational Int
n) ControlPattern
p) (ControlPattern -> ControlPattern)
-> ControlPattern -> ControlPattern
forall a b. (a -> b) -> a -> b
$ [ControlPattern] -> ControlPattern
forall a. [Pattern a] -> Pattern a
fastcat ([ControlPattern] -> ControlPattern)
-> [ControlPattern] -> ControlPattern
forall a b. (a -> b) -> a -> b
$ (Int -> ControlPattern) -> [Int] -> [ControlPattern]
forall a b. (a -> b) -> [a] -> [b]
map Int -> ControlPattern
forall {a}. Integral a => a -> ControlPattern
offset [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
  where
    offset :: a -> ControlPattern
offset a
i = (Double, Double) -> ValueMap -> ValueMap
mergePlayRange (a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n, a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
i a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) (ValueMap -> ValueMap) -> ControlPattern -> ControlPattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ControlPattern
p

mergePlayRange :: (Double, Double) -> ValueMap -> ValueMap
mergePlayRange :: (Double, Double) -> ValueMap -> ValueMap
mergePlayRange (Double
b, Double
e) ValueMap
cm = String -> Value -> ValueMap -> ValueMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
"begin" (Double -> Value
VF ((Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
d') Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
b')) (ValueMap -> ValueMap) -> ValueMap -> ValueMap
forall a b. (a -> b) -> a -> b
$ String -> Value -> ValueMap -> ValueMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
"end" (Double -> Value
VF ((Double
e Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
d') Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
b')) ValueMap
cm
  where
    b' :: Double
b' = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0 (Maybe Double -> Double) -> Maybe Double -> Double
forall a b. (a -> b) -> a -> b
$ String -> ValueMap -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
"begin" ValueMap
cm Maybe Value -> (Value -> Maybe Double) -> Maybe Double
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Maybe Double
getF
    e' :: Double
e' = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1 (Maybe Double -> Double) -> Maybe Double -> Double
forall a b. (a -> b) -> a -> b
$ String -> ValueMap -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
"end" ValueMap
cm Maybe Value -> (Value -> Maybe Double) -> Maybe Double
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Maybe Double
getF
    d' :: Double
d' = Double
e' Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
b'

-- |
-- 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
-- will be 1/16th of a sample long:
--
-- > d1 $ slow 32 $ striateBy 32 (1/16) $ sound "bev"
--
-- 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 :: Pattern Int -> Pattern Double -> ControlPattern -> ControlPattern
striateBy = (Int -> Double -> ControlPattern -> ControlPattern)
-> Pattern Int
-> Pattern Double
-> ControlPattern
-> ControlPattern
forall a b c d.
(a -> b -> c -> Pattern d)
-> Pattern a -> Pattern b -> c -> Pattern d
patternify2 Int -> Double -> ControlPattern -> ControlPattern
_striateBy

-- | DEPRECATED, use 'striateBy' instead.
striate' :: Pattern Int -> Pattern Double -> ControlPattern -> ControlPattern
striate' :: Pattern Int -> Pattern Double -> ControlPattern -> ControlPattern
striate' = Pattern Int -> Pattern Double -> ControlPattern -> ControlPattern
striateBy

_striateBy :: Int -> Double -> ControlPattern -> ControlPattern
_striateBy :: Int -> Double -> ControlPattern -> ControlPattern
_striateBy Int
n Double
f ControlPattern
p = ControlPattern -> ControlPattern -> ControlPattern
forall a b. Pattern a -> Pattern b -> Pattern b
keepTactus ((Time -> Time) -> ControlPattern -> ControlPattern
forall a. (Time -> Time) -> Pattern a -> Pattern a
withTactus (Time -> Time -> Time
forall a. Num a => a -> a -> a
* Int -> Time
forall a. Real a => a -> Time
toRational Int
n) ControlPattern
p) (ControlPattern -> ControlPattern)
-> ControlPattern -> ControlPattern
forall a b. (a -> b) -> a -> b
$ [ControlPattern] -> ControlPattern
forall a. [Pattern a] -> Pattern a
fastcat ([ControlPattern] -> ControlPattern)
-> [ControlPattern] -> ControlPattern
forall a b. (a -> b) -> a -> b
$ (Int -> ControlPattern) -> [Int] -> [ControlPattern]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> ControlPattern
offset (Double -> ControlPattern)
-> (Int -> Double) -> Int -> ControlPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral) [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
  where
    offset :: Double -> ControlPattern
offset Double
i = (Double, Double) -> ValueMap -> ValueMap
mergePlayRange (Double
slot Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
i, (Double
slot Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
i) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
f) (ValueMap -> ValueMap) -> ControlPattern -> ControlPattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ControlPattern
p
    slot :: Double
slot = (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
f) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

-- | `gap` is similar to `chop` in that it granualizes every sample in place as it is played,
-- but every other grain is silent. Use an integer value to specify how many granules
-- each sample is chopped into:
--
-- > d1 $ gap 8 $ sound "jvbass"
-- > d1 $ gap 16 $ sound "[jvbass drum:4]"
gap :: Pattern Int -> ControlPattern -> ControlPattern
gap :: Pattern Int -> ControlPattern -> ControlPattern
gap = (Int -> ControlPattern -> ControlPattern)
-> Pattern Int -> ControlPattern -> ControlPattern
forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
patternify Int -> ControlPattern -> ControlPattern
_gap

_gap :: Int -> ControlPattern -> ControlPattern
_gap :: Int -> ControlPattern -> ControlPattern
_gap Int
n ControlPattern
p = Time -> ControlPattern -> ControlPattern
forall a. Time -> Pattern a -> Pattern a
_fast (Int -> Time
forall a. Real a => a -> Time
toRational Int
n) ([ControlPattern] -> ControlPattern
forall a. [Pattern a] -> Pattern a
cat [ValueMap -> ControlPattern
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ValueMap
1, ControlPattern
forall a. Pattern a
silence]) ControlPattern -> ControlPattern -> ControlPattern
forall (a :: * -> *) b.
(Applicative a, Unionable b) =>
a b -> a b -> a b
|>| Int -> ControlPattern -> ControlPattern
_chop Int
n ControlPattern
p

-- |
--  @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 :: Time -> ControlPattern -> [ControlPattern] -> ControlPattern
weave Time
t ControlPattern
p [ControlPattern]
ps = Time
-> ControlPattern
-> [ControlPattern -> ControlPattern]
-> ControlPattern
forall a.
Time -> Pattern a -> [Pattern a -> Pattern a] -> Pattern a
weave' Time
t ControlPattern
p ((ControlPattern -> ControlPattern -> ControlPattern)
-> [ControlPattern] -> [ControlPattern -> ControlPattern]
forall a b. (a -> b) -> [a] -> [b]
map ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
(#) [ControlPattern]
ps)

-- |
--  @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 :: forall a.
Time -> Pattern a -> [Pattern a -> Pattern a] -> Pattern a
weaveWith Time
t Pattern a
p [Pattern a -> Pattern a]
fs
  | Integer
l Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = Pattern a
forall a. Pattern a
silence
  | Bool
otherwise = Time -> Pattern a -> Pattern a
forall a. Time -> Pattern a -> Pattern a
_slow Time
t (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
stack ([Pattern a] -> Pattern a) -> [Pattern a] -> Pattern a
forall a b. (a -> b) -> a -> b
$ (Int -> (Pattern a -> Pattern a) -> Pattern a)
-> [Int] -> [Pattern a -> Pattern a] -> [Pattern a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
i Pattern a -> Pattern a
f -> (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Integer -> Integer -> Time
forall a. Integral a => a -> a -> Ratio a
% Integer
l) Time -> Pattern a -> Pattern a
forall a. Time -> Pattern a -> Pattern a
`rotL` Time -> Pattern a -> Pattern a
forall a. Time -> Pattern a -> Pattern a
_fast Time
t (Pattern a -> Pattern a
f (Time -> Pattern a -> Pattern a
forall a. Time -> Pattern a -> Pattern a
_slow Time
t Pattern a
p))) [Int
0 :: Int ..] [Pattern a -> Pattern a]
fs
  where
    l :: Integer
l = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ [Pattern a -> Pattern a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pattern a -> Pattern a]
fs

-- | An old alias for 'weaveWith'.
weave' :: Time -> Pattern a -> [Pattern a -> Pattern a] -> Pattern a
weave' :: forall a.
Time -> Pattern a -> [Pattern a -> Pattern a] -> Pattern a
weave' = Time -> Pattern a -> [Pattern a -> Pattern a] -> Pattern a
forall a.
Time -> Pattern a -> [Pattern a -> Pattern a] -> Pattern a
weaveWith

-- |
-- (A function that takes two ControlPatterns, and blends them together into
-- a new ControlPattern. An ControlPattern is basically a pattern of messages to
-- a synthesiser.)
--
-- Shifts between the two given patterns, using distortion.
--
-- Example:
--
-- > d1 $ interlace (sound  "bd sn kurt") (every 3 rev $ sound  "bd sn:2")
interlace :: ControlPattern -> ControlPattern -> ControlPattern
interlace :: ControlPattern -> ControlPattern -> ControlPattern
interlace ControlPattern
a ControlPattern
b = Time -> ControlPattern -> [ControlPattern] -> ControlPattern
weave Time
16 (Pattern Double -> ControlPattern
P.shape (Pattern Double
forall a. Fractional a => Pattern a
sine Pattern Double -> Pattern Double -> Pattern Double
forall a. Num a => a -> a -> a
* Pattern Double
0.9)) [ControlPattern
a, ControlPattern
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"

Like `striate`, these use the `begin` and `end` parameters internally, as well as the `loop` parameter for these versions.
-}
striateL :: Pattern Int -> Pattern Int -> ControlPattern -> ControlPattern
striateL = tParam2 _striateL

striateL' :: Pattern Int -> Pattern Double -> Pattern Int -> ControlPattern -> ControlPattern
striateL' = tParam3 _striateL'

_striateL :: Int -> Int -> ControlPattern -> ControlPattern
_striateL n l p = _striate n p # loop (pure $ fromIntegral l)
_striateL' n f l p = _striateBy n f p # loop (pure $ fromIntegral l)

en :: [(Int, Int)] -> Pattern String -> Pattern String
en ns p = stack $ map (\(i, (k, n)) -> _e k n (samples p (pure i))) $ enumerate ns

-}

-- | @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 :: Pattern Int -> Pattern Int -> ControlPattern -> ControlPattern
slice Pattern Int
pN Pattern Int
pI ControlPattern
p = Pattern Double -> ControlPattern
P.begin Pattern Double
b ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> ControlPattern
P.end Pattern Double
e ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# ControlPattern
p
  where
    b :: Pattern Double
b = Int -> Int -> Double
div' (Int -> Int -> Double) -> Pattern Int -> Pattern (Int -> Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Int
pI Pattern (Int -> Double) -> Pattern Int -> Pattern Double
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
<* Pattern Int
pN
    e :: Pattern Double
e = Pattern Double
b Pattern Double -> Pattern Double -> Pattern Double
forall a. Num a => a -> a -> a
+ Pattern Double
pWidth
    pWidth :: Pattern Double
pWidth = (\Int
x -> Double
1.0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (Int -> Double) -> Pattern Int -> Pattern Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Int
pN
    div' :: Int -> Int -> Double
    div' :: Int -> Int -> Double
div' Int
num Int
den = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
num Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
den) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
den

_slice :: Int -> Int -> ControlPattern -> ControlPattern
_slice :: Int -> Int -> ControlPattern -> ControlPattern
_slice Int
n Int
i ControlPattern
p =
  ControlPattern
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 :: Pattern Int -> ControlPattern -> ControlPattern
randslice = (Int -> ControlPattern -> ControlPattern)
-> Pattern Int -> ControlPattern -> ControlPattern
forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
patternify ((Int -> ControlPattern -> ControlPattern)
 -> Pattern Int -> ControlPattern -> ControlPattern)
-> (Int -> ControlPattern -> ControlPattern)
-> Pattern Int
-> ControlPattern
-> ControlPattern
forall a b. (a -> b) -> a -> b
$ \Int
n ControlPattern
p -> ControlPattern -> ControlPattern -> ControlPattern
forall a b. Pattern a -> Pattern b -> Pattern b
keepTactus ((Time -> Time) -> ControlPattern -> ControlPattern
forall a. (Time -> Time) -> Pattern a -> Pattern a
withTactus (Time -> Time -> Time
forall a. Num a => a -> a -> a
* (Int -> Time
forall a. Real a => a -> Time
toRational Int
n)) (ControlPattern -> ControlPattern)
-> ControlPattern -> ControlPattern
forall a b. (a -> b) -> a -> b
$ ControlPattern
p) (ControlPattern -> ControlPattern)
-> ControlPattern -> ControlPattern
forall a b. (a -> b) -> a -> b
$ Pattern ControlPattern -> ControlPattern
forall a. Pattern (Pattern a) -> Pattern a
innerJoin (Pattern ControlPattern -> ControlPattern)
-> Pattern ControlPattern -> ControlPattern
forall a b. (a -> b) -> a -> b
$ (\Int
i -> Int -> Int -> ControlPattern -> ControlPattern
_slice Int
n Int
i ControlPattern
p) (Int -> ControlPattern) -> Pattern Int -> Pattern ControlPattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Pattern Int
forall a. Num a => Int -> Pattern a
_irand Int
n

_splice :: Int -> Pattern Int -> ControlPattern -> Pattern (Map.Map String Value)
_splice :: Int -> Pattern Int -> ControlPattern -> ControlPattern
_splice Int
bits Pattern Int
ipat ControlPattern
pat = (Event ValueMap -> Event ValueMap)
-> ControlPattern -> ControlPattern
forall a b. (Event a -> Event b) -> Pattern a -> Pattern b
withEvent Event ValueMap -> Event ValueMap
forall {k}.
(Ord k, IsString k) =>
EventF Arc (Map k Value) -> EventF Arc (Map k Value)
f (Pattern Int -> Pattern Int -> ControlPattern -> ControlPattern
slice (Int -> Pattern Int
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
bits) Pattern Int
ipat ControlPattern
pat) ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern String -> ControlPattern
P.unit (String -> Pattern String
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"c")
  where
    f :: EventF Arc (Map k Value) -> EventF Arc (Map k Value)
f EventF Arc (Map k Value)
ev = case k -> Map k Value -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
"speed" (EventF Arc (Map k Value) -> Map k Value
forall a b. EventF a b -> b
value EventF Arc (Map k Value)
ev) of
      (Just (VF Double
s)) -> EventF Arc (Map k Value)
ev {value = Map.insert "speed" (VF $ d * s) (value ev)} -- if there is a speed parameter already present
      Maybe Value
_ -> EventF Arc (Map k Value)
ev {value = Map.insert "speed" (VF d) (value ev)}
      where
        d :: Double
d = Double
sz Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Time -> Double
forall a. Fractional a => Time -> a
fromRational (EventF Arc (Map k Value) -> Time
forall a. Event a -> Time
wholeStop EventF Arc (Map k Value)
ev Time -> Time -> Time
forall a. Num a => a -> a -> a
- EventF Arc (Map k Value) -> Time
forall a. Event a -> Time
wholeStart EventF Arc (Map k Value)
ev)
        sz :: Double
sz = Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
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 :: Pattern Int -> Pattern Int -> ControlPattern -> ControlPattern
splice Pattern Int
bitpat Pattern Int
ipat ControlPattern
pat = Pattern Int -> ControlPattern -> ControlPattern
forall a b. Pattern a -> Pattern b -> Pattern b
setTactusFrom Pattern Int
bitpat (ControlPattern -> ControlPattern)
-> ControlPattern -> ControlPattern
forall a b. (a -> b) -> a -> b
$ Pattern ControlPattern -> ControlPattern
forall a. Pattern (Pattern a) -> Pattern a
innerJoin (Pattern ControlPattern -> ControlPattern)
-> Pattern ControlPattern -> ControlPattern
forall a b. (a -> b) -> a -> b
$ (\Int
bits -> Int -> Pattern Int -> ControlPattern -> ControlPattern
_splice Int
bits Pattern Int
ipat ControlPattern
pat) (Int -> ControlPattern) -> Pattern Int -> Pattern ControlPattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Int
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"
--
--  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 :: Pattern Time -> ControlPattern -> ControlPattern
loopAt Pattern Time
n ControlPattern
p = Pattern Time -> ControlPattern -> ControlPattern
forall a. Pattern Time -> Pattern a -> Pattern a
slow Pattern Time
n ControlPattern
p ControlPattern -> ControlPattern -> ControlPattern
forall a. Num a => Pattern a -> Pattern a -> Pattern a
|* Pattern Double -> ControlPattern
P.speed (Time -> Double
forall a. Fractional a => Time -> a
fromRational (Time -> Double) -> Pattern Time -> Pattern Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Pattern Time
1 Pattern Time -> Pattern Time -> Pattern Time
forall a. Fractional a => a -> a -> a
/ Pattern Time
n)) ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern String -> ControlPattern
P.unit (String -> Pattern String
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"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 :: Pattern Time -> ControlPattern -> ControlPattern
hurry !Pattern Time
x = (ControlPattern -> ControlPattern -> ControlPattern
forall a. Num a => Pattern a -> Pattern a -> Pattern a
|* Pattern Double -> ControlPattern
P.speed (Time -> Double
forall a. Fractional a => Time -> a
fromRational (Time -> Double) -> Pattern Time -> Pattern Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Time
x)) (ControlPattern -> ControlPattern)
-> (ControlPattern -> ControlPattern)
-> ControlPattern
-> ControlPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern Time -> ControlPattern -> ControlPattern
forall a. Pattern Time -> Pattern a -> Pattern a
fast Pattern Time
x

-- | @smash@ is a combination of `spread` and `striate` — it cuts the samples
-- into the given number of bits, and then cuts between playing the loop
-- at different speeds according to the values in the list. So this:
--
-- > d1 $ smash 3 [2,3,4] $ sound "ho ho:2 ho:3 hc"
--
-- is a bit like this:
--
-- > d1 $ spread (slow) [2,3,4] $ striate 3 $ sound "ho ho:2 ho:3 hc"
--
-- This is quite dancehall:
--
-- > d1 $ ( spread' slow "1%4 2 1 3"
-- >      $ spread (striate) [2,3,4,1]
-- >      $ sound "sn:2 sid:3 cp sid:4"
-- >      )
-- >    # speed "[1 2 1 1]/2"
smash :: Pattern Int -> [Pattern Time] -> ControlPattern -> Pattern ValueMap
smash :: Pattern Int -> [Pattern Time] -> ControlPattern -> ControlPattern
smash Pattern Int
n [Pattern Time]
xs ControlPattern
p = [ControlPattern] -> ControlPattern
forall a. [Pattern a] -> Pattern a
slowcat ([ControlPattern] -> ControlPattern)
-> [ControlPattern] -> ControlPattern
forall a b. (a -> b) -> a -> b
$ (Pattern Time -> ControlPattern)
-> [Pattern Time] -> [ControlPattern]
forall a b. (a -> b) -> [a] -> [b]
map (Pattern Time -> ControlPattern -> ControlPattern
forall a. Pattern Time -> Pattern a -> Pattern a
`slow` ControlPattern
p') [Pattern Time]
xs
  where
    p' :: ControlPattern
p' = Pattern Int -> ControlPattern -> ControlPattern
striate Pattern Int
n ControlPattern
p

-- | 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' :: Int -> [Pattern Time] -> ControlPattern -> ControlPattern
smash' Int
n [Pattern Time]
xs ControlPattern
p = [ControlPattern] -> ControlPattern
forall a. [Pattern a] -> Pattern a
slowcat ([ControlPattern] -> ControlPattern)
-> [ControlPattern] -> ControlPattern
forall a b. (a -> b) -> a -> b
$ (Pattern Time -> ControlPattern)
-> [Pattern Time] -> [ControlPattern]
forall a b. (a -> b) -> [a] -> [b]
map (Pattern Time -> ControlPattern -> ControlPattern
forall a. Pattern Time -> Pattern a -> Pattern a
`slow` ControlPattern
p') [Pattern Time]
xs
  where
    p' :: ControlPattern
p' = Int -> ControlPattern -> ControlPattern
_chop Int
n ControlPattern
p

-- |
--    Applies a type of delay to a pattern.
--    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"
--
--    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"
echo :: Pattern Integer -> Pattern Rational -> Pattern Double -> ControlPattern -> ControlPattern
echo :: Pattern Integer
-> Pattern Time
-> Pattern Double
-> ControlPattern
-> ControlPattern
echo = (Integer -> Time -> Double -> ControlPattern -> ControlPattern)
-> Pattern Integer
-> Pattern Time
-> Pattern Double
-> ControlPattern
-> ControlPattern
forall a b c d e.
(a -> b -> c -> Pattern d -> Pattern e)
-> Pattern a -> Pattern b -> Pattern c -> Pattern d -> Pattern e
patternify3' Integer -> Time -> Double -> ControlPattern -> ControlPattern
_echo

_echo :: Integer -> Rational -> Double -> ControlPattern -> ControlPattern
_echo :: Integer -> Time -> Double -> ControlPattern -> ControlPattern
_echo Integer
count Time
time Double
feedback ControlPattern
p = Integer
-> Time
-> (ControlPattern -> ControlPattern)
-> ControlPattern
-> ControlPattern
forall n a.
(Num n, Ord n) =>
n -> Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_echoWith Integer
count Time
time (ControlPattern -> ControlPattern -> ControlPattern
forall a. Num a => Pattern a -> Pattern a -> Pattern a
|* Pattern Double -> ControlPattern
P.gain (Double -> Pattern Double
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Pattern Double) -> Double -> Pattern Double
forall a b. (a -> b) -> a -> b
$ Double
feedback)) ControlPattern
p

-- |
--  @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 4 (1/6) (|* speed "1.5") $ sound "arpy arpy:2"
--
--  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 :: forall a.
Pattern Int
-> Pattern Time
-> (Pattern a -> Pattern a)
-> Pattern a
-> Pattern a
echoWith Pattern Int
n Pattern Time
t Pattern a -> Pattern a
f Pattern a
p = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
innerJoin (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ (\Int
a Time
b -> Int -> Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall n a.
(Num n, Ord n) =>
n -> Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_echoWith Int
a Time
b Pattern a -> Pattern a
f Pattern a
p) (Int -> Time -> Pattern a)
-> Pattern Int -> Pattern (Time -> Pattern a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Int
n Pattern (Time -> Pattern a) -> Pattern Time -> Pattern (Pattern a)
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
<* Pattern Time
t

_echoWith :: (Num n, Ord n) => n -> Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_echoWith :: forall n a.
(Num n, Ord n) =>
n -> Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_echoWith n
count Time
time Pattern a -> Pattern a
f Pattern a
p
  | n
count n -> n -> Bool
forall a. Ord a => a -> a -> Bool
<= n
1 = Pattern a
p
  | Bool
otherwise = Pattern a -> Pattern a -> Pattern a
forall a. Pattern a -> Pattern a -> Pattern a
overlay (Pattern a -> Pattern a
f (Time
time Time -> Pattern a -> Pattern a
forall a. Time -> Pattern a -> Pattern a
`rotR` n -> Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall n a.
(Num n, Ord n) =>
n -> Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_echoWith (n
count n -> n -> n
forall a. Num a => a -> a -> a
- n
1) Time
time Pattern a -> Pattern a
f Pattern a
p)) Pattern a
p

-- | DEPRECATED, use 'echo' instead
stut :: Pattern Integer -> Pattern Double -> Pattern Rational -> ControlPattern -> ControlPattern
stut :: Pattern Integer
-> Pattern Double
-> Pattern Time
-> ControlPattern
-> ControlPattern
stut = (Integer -> Double -> Time -> ControlPattern -> ControlPattern)
-> Pattern Integer
-> Pattern Double
-> Pattern Time
-> ControlPattern
-> ControlPattern
forall a b c d e.
(a -> b -> c -> Pattern d -> Pattern e)
-> Pattern a -> Pattern b -> Pattern c -> Pattern d -> Pattern e
patternify3' Integer -> Double -> Time -> ControlPattern -> ControlPattern
_stut

_stut :: Integer -> Double -> Rational -> ControlPattern -> ControlPattern
_stut :: Integer -> Double -> Time -> ControlPattern -> ControlPattern
_stut Integer
count Double
feedback Time
steptime ControlPattern
p = [ControlPattern] -> ControlPattern
forall a. [Pattern a] -> Pattern a
stack (ControlPattern
p ControlPattern -> [ControlPattern] -> [ControlPattern]
forall a. a -> [a] -> [a]
: (Integer -> ControlPattern) -> [Integer] -> [ControlPattern]
forall a b. (a -> b) -> [a] -> [b]
map (\Integer
x -> ((Integer
x Integer -> Integer -> Time
forall a. Integral a => a -> a -> Ratio a
% Integer
1) Time -> Time -> Time
forall a. Num a => a -> a -> a
* Time
steptime) Time -> ControlPattern -> ControlPattern
forall a. Time -> Pattern a -> Pattern a
`rotR` (ControlPattern
p ControlPattern -> ControlPattern -> ControlPattern
forall a. Num a => Pattern a -> Pattern a -> Pattern a
|* Pattern Double -> ControlPattern
P.gain (Double -> Pattern Double
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Pattern Double) -> Double -> Pattern Double
forall a b. (a -> b) -> a -> b
$ Double -> Double
scalegain (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)))) [Integer
1 .. (Integer
count Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)])
  where
    scalegain :: Double -> Double
scalegain =
      (Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
feedback) (Double -> Double) -> (Double -> Double) -> Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
feedback)) (Double -> Double) -> (Double -> Double) -> Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
count) (Double -> Double) -> (Double -> Double) -> Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
count Double -> Double -> Double
forall a. Num a => a -> a -> a
-)

-- | DEPRECATED, use 'echoWith' instead
stutWith :: Pattern Int -> Pattern Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
stutWith :: forall a.
Pattern Int
-> Pattern Time
-> (Pattern a -> Pattern a)
-> Pattern a
-> Pattern a
stutWith Pattern Int
n Pattern Time
t Pattern a -> Pattern a
f Pattern a
p = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
innerJoin (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ (\Int
a Time
b -> Int -> Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall n a.
(Num n, Ord n) =>
n -> Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_stutWith Int
a Time
b Pattern a -> Pattern a
f Pattern a
p) (Int -> Time -> Pattern a)
-> Pattern Int -> Pattern (Time -> Pattern a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Int
n Pattern (Time -> Pattern a) -> Pattern Time -> Pattern (Pattern a)
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
<* Pattern Time
t

_stutWith :: (Num n, Ord n) => n -> Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_stutWith :: forall n a.
(Num n, Ord n) =>
n -> Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_stutWith n
count Time
steptime Pattern a -> Pattern a
f Pattern a
p
  | n
count n -> n -> Bool
forall a. Ord a => a -> a -> Bool
<= n
1 = Pattern a
p
  | Bool
otherwise = Pattern a -> Pattern a -> Pattern a
forall a. Pattern a -> Pattern a -> Pattern a
overlay (Pattern a -> Pattern a
f (Time
steptime Time -> Pattern a -> Pattern a
forall a. Time -> Pattern a -> Pattern a
`rotR` n -> Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall n a.
(Num n, Ord n) =>
n -> Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_stutWith (n
count n -> n -> n
forall a. Num a => a -> a -> a
- n
1) Time
steptime Pattern a -> Pattern a
f Pattern a
p)) Pattern a
p

-- | DEPRECATED, use 'echoWith' instead
stut' :: Pattern Int -> Pattern Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
stut' :: forall a.
Pattern Int
-> Pattern Time
-> (Pattern a -> Pattern a)
-> Pattern a
-> Pattern a
stut' = Pattern Int
-> Pattern Time
-> (Pattern a -> Pattern a)
-> Pattern a
-> Pattern a
forall a.
Pattern Int
-> Pattern Time
-> (Pattern a -> Pattern a)
-> Pattern a
-> Pattern a
stutWith

-- | Turns a pattern of seconds into a pattern of (rational) cycle durations
sec :: (Fractional a) => Pattern a -> Pattern a
sec :: forall a. Fractional a => Pattern a -> Pattern a
sec Pattern a
p = (Double -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> a) -> Pattern Double -> Pattern a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Double -> String -> Pattern Double
cF Double
1 String
"_cps") Pattern a -> Pattern a -> Pattern a
forall a. Num a => Pattern a -> Pattern a -> Pattern a
*| Pattern a
p

-- | Turns a pattern of milliseconds into a pattern of (rational)
-- cycle durations, according to the current cps.
msec :: (Fractional a) => Pattern a -> Pattern a
msec :: forall a. Fractional a => Pattern a -> Pattern a
msec Pattern a
p = (Double -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> a) -> (Double -> Double) -> Double -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1000) (Double -> a) -> Pattern Double -> Pattern a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Double -> String -> Pattern Double
cF Double
1 String
"_cps") Pattern a -> Pattern a -> Pattern a
forall a. Num a => Pattern a -> Pattern a -> Pattern a
*| Pattern a
p

-- | Align the start of a pattern with the time a pattern is evaluated,
-- rather than the global start time. Because of this, the pattern will
-- probably not be aligned to the pattern grid.
trigger :: Pattern a -> Pattern a
trigger :: forall a. Pattern a -> Pattern a
trigger = (Time -> Time) -> Pattern a -> Pattern a
forall a. (Time -> Time) -> Pattern a -> Pattern a
triggerWith Time -> Time
forall a. a -> a
id

-- | (Alias @__qt__@) Quantise trigger. Aligns the start of the pattern
-- 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
--
-- 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)"
--
-- Alternatively, you can use 'wait' to achieve the same result:
--
-- > wait 1 1 $ s "bd hh hh hh"
qtrigger :: Pattern a -> Pattern a
qtrigger :: forall a. Pattern a -> Pattern a
qtrigger = Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
ctrigger

-- | Alias for 'qtrigger'.
qt :: Pattern a -> Pattern a
qt :: forall a. Pattern a -> Pattern a
qt = Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
qtrigger

-- | Ceiling trigger. Aligns the start of a pattern to the next cycle
-- boundary, just like 'qtrigger'.
ctrigger :: Pattern a -> Pattern a
ctrigger :: forall a. Pattern a -> Pattern a
ctrigger = (Time -> Time) -> Pattern a -> Pattern a
forall a. (Time -> Time) -> Pattern a -> Pattern a
triggerWith ((Time -> Time) -> Pattern a -> Pattern a)
-> (Time -> Time) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ (Int -> Time
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Rational) (Int -> Time) -> (Time -> Int) -> Time -> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> Int
forall b. Integral b => Time -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling

-- | Rounded trigger. Aligns the start of a pattern to the nearest cycle
-- boundary, either next or previous.
rtrigger :: Pattern a -> Pattern a
rtrigger :: forall a. Pattern a -> Pattern a
rtrigger = (Time -> Time) -> Pattern a -> Pattern a
forall a. (Time -> Time) -> Pattern a -> Pattern a
triggerWith ((Time -> Time) -> Pattern a -> Pattern a)
-> (Time -> Time) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ (Int -> Time
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Rational) (Int -> Time) -> (Time -> Int) -> Time -> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> Int
forall b. Integral b => Time -> b
forall a b. (RealFrac a, Integral b) => a -> b
round

-- | Floor trigger. Aligns the start of a pattern to the previous cycle
-- boundary.
ftrigger :: Pattern a -> Pattern a
ftrigger :: forall a. Pattern a -> Pattern a
ftrigger = (Time -> Time) -> Pattern a -> Pattern a
forall a. (Time -> Time) -> Pattern a -> Pattern a
triggerWith ((Time -> Time) -> Pattern a -> Pattern a)
-> (Time -> Time) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ (Int -> Time
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Rational) (Int -> Time) -> (Time -> Int) -> Time -> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> Int
forall b. Integral b => Time -> b
forall a b. (RealFrac a, Integral b) => a -> b
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@.
--
--  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 :: forall a. Int -> Pattern a -> Pattern a
mtrigger Int
n = (Time -> Time) -> Pattern a -> Pattern a
forall a. (Time -> Time) -> Pattern a -> Pattern a
triggerWith ((Time -> Time) -> Pattern a -> Pattern a)
-> (Time -> Time) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ Int -> Time
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Time) -> (Time -> Int) -> Time -> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> Int
forall {a}. RealFrac a => a -> Int
nextMod
  where
    nextMod :: a -> Int
nextMod a
t = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (a
t a -> a -> a
forall a. Fractional a => a -> a -> a
/ (Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n))

-- | Alias for 'mtrigger'.
mt :: Int -> Pattern a -> Pattern a
mt :: forall a. Int -> Pattern a -> Pattern a
mt = Int -> Pattern a -> Pattern a
forall a. Int -> Pattern a -> Pattern a
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 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 :: forall a. (Time -> Time) -> Pattern a -> Pattern a
triggerWith Time -> Time
f Pattern a
pat = Pattern a
pat {query = q}
  where
    q :: State -> [Event a]
q State
st = Pattern a -> State -> [Event a]
forall a. Pattern a -> State -> [Event a]
query (Time -> Pattern a -> Pattern a
forall a. Time -> Pattern a -> Pattern a
rotR (State -> Time
offset State
st) Pattern a
pat) State
st
    offset :: State -> Time
offset State
st =
      Time -> Maybe Time -> Time
forall a. a -> Maybe a -> a
fromMaybe Time
0 (Maybe Time -> Time) -> Maybe Time -> Time
forall a b. (a -> b) -> a -> b
$
        Time -> Time
f
          (Time -> Time) -> Maybe Time -> Maybe Time
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ValueMap -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
patternTimeID (State -> ValueMap
controls State
st) Maybe Value -> (Value -> Maybe Time) -> Maybe Time
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Maybe Time
getR)

splat :: Pattern Int -> ControlPattern -> ControlPattern -> ControlPattern
splat :: Pattern Int -> ControlPattern -> ControlPattern -> ControlPattern
splat Pattern Int
slices ControlPattern
epat ControlPattern
pat = Pattern Int -> ControlPattern -> ControlPattern
chop Pattern Int
slices ControlPattern
pat ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Int -> Pattern Int -> ControlPattern -> ControlPattern
forall a. Pattern Int -> Pattern Int -> Pattern a -> Pattern a
bite Pattern Int
1 (Int -> ValueMap -> Int
forall a b. a -> b -> a
const Int
0 (ValueMap -> Int) -> ControlPattern -> Pattern Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ControlPattern
pat) ControlPattern
epat