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

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           Prelude hiding ((<*), (*>))

import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe, isJust, fromJust)
import Data.Ratio

import Sound.Tidal.Pattern
import Sound.Tidal.Core
import Sound.Tidal.StreamTypes (patternTimeID)
import Sound.Tidal.UI
import qualified Sound.Tidal.Params as P
import Sound.Tidal.Utils

{- | `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
tParam 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
tParam 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
eTime -> 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
iTime -> 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
eTime -> 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
iInt -> 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
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]

_chop :: Int -> ControlPattern -> ControlPattern
_chop :: Int -> ControlPattern -> ControlPattern
_chop Int
n = ([Event ValueMap] -> [Event ValueMap])
-> ControlPattern -> ControlPattern
forall a b. ([Event a] -> [Event b]) -> Pattern a -> Pattern b
withEvents ((Event ValueMap -> [Event ValueMap])
-> [Event ValueMap] -> [Event ValueMap]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Event ValueMap -> [Event ValueMap]
chopEvent)
  where -- for each part,
        chopEvent :: Event ValueMap -> [Event ValueMap]
        chopEvent :: Event ValueMap -> [Event ValueMap]
chopEvent (Event Context
c (Just Arc
w) Arc
p' ValueMap
v) = ((Int, (Arc, Arc)) -> Event ValueMap)
-> [(Int, (Arc, Arc))] -> [Event ValueMap]
forall a b. (a -> b) -> [a] -> [b]
map (Context -> ValueMap -> Int -> (Int, (Arc, Arc)) -> Event ValueMap
chomp Context
c ValueMap
v ([Arc] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Arc] -> Int) -> [Arc] -> Int
forall a b. (a -> b) -> a -> b
$ Arc -> Int -> [Arc]
chopArc Arc
w Int
n)) ([(Int, (Arc, Arc))] -> [Event ValueMap])
-> [(Int, (Arc, Arc))] -> [Event ValueMap]
forall a b. (a -> b) -> a -> b
$ Arc -> Arc -> [(Int, (Arc, Arc))]
arcs Arc
w Arc
p'
        -- ignoring 'analog' events (those without wholes),
        chopEvent Event ValueMap
_ = []
        -- cut whole into n bits, and number them
        arcs :: Arc -> Arc -> [(Int, (Arc, Arc))]
arcs Arc
w' Arc
p' = Arc -> [Arc] -> [(Int, (Arc, Arc))]
numberedArcs Arc
p' ([Arc] -> [(Int, (Arc, Arc))]) -> [Arc] -> [(Int, (Arc, Arc))]
forall a b. (a -> b) -> a -> b
$ Arc -> Int -> [Arc]
chopArc Arc
w' Int
n
        -- each bit is a new whole, with part that's the intersection of old part and new whole
        -- (discard new parts that don't intersect with the old part)
        numberedArcs :: Arc -> [Arc] -> [(Int, (Arc, Arc))]
        numberedArcs :: Arc -> [Arc] -> [(Int, (Arc, Arc))]
numberedArcs Arc
p' [Arc]
as = ((Int, (Arc, Maybe Arc)) -> (Int, (Arc, Arc)))
-> [(Int, (Arc, Maybe Arc))] -> [(Int, (Arc, Arc))]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe Arc -> Arc
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Arc -> Arc) -> (Arc, Maybe Arc) -> (Arc, Arc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ((Arc, Maybe Arc) -> (Arc, Arc))
-> (Int, (Arc, Maybe Arc)) -> (Int, (Arc, Arc))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([(Int, (Arc, Maybe Arc))] -> [(Int, (Arc, Arc))])
-> [(Int, (Arc, Maybe Arc))] -> [(Int, (Arc, Arc))]
forall a b. (a -> b) -> a -> b
$ ((Int, (Arc, Maybe Arc)) -> Bool)
-> [(Int, (Arc, Maybe Arc))] -> [(Int, (Arc, Maybe Arc))]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe Arc -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Arc -> Bool)
-> ((Int, (Arc, Maybe Arc)) -> Maybe Arc)
-> (Int, (Arc, Maybe Arc))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Arc, Maybe Arc) -> Maybe Arc
forall a b. (a, b) -> b
snd ((Arc, Maybe Arc) -> Maybe Arc)
-> ((Int, (Arc, Maybe Arc)) -> (Arc, Maybe Arc))
-> (Int, (Arc, Maybe Arc))
-> Maybe Arc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, (Arc, Maybe Arc)) -> (Arc, Maybe Arc)
forall a b. (a, b) -> b
snd) ([(Int, (Arc, Maybe Arc))] -> [(Int, (Arc, Maybe Arc))])
-> [(Int, (Arc, Maybe Arc))] -> [(Int, (Arc, Maybe Arc))]
forall a b. (a -> b) -> a -> b
$ [(Arc, Maybe Arc)] -> [(Int, (Arc, Maybe Arc))]
forall a. [a] -> [(Int, a)]
enumerate ([(Arc, Maybe Arc)] -> [(Int, (Arc, Maybe Arc))])
-> [(Arc, Maybe Arc)] -> [(Int, (Arc, Maybe Arc))]
forall a b. (a -> b) -> a -> b
$ (Arc -> (Arc, Maybe Arc)) -> [Arc] -> [(Arc, Maybe Arc)]
forall a b. (a -> b) -> [a] -> [b]
map (\Arc
a -> (Arc
a, Arc -> Arc -> Maybe Arc
subArc Arc
p' Arc
a)) [Arc]
as
        -- begin set to i/n, end set to i+1/n
        -- if the old event had a begin and end, then multiply the new
        -- begin and end values by the old difference (end-begin), and
        -- add the old begin
        chomp :: Context -> ValueMap -> Int -> (Int, (Arc, Arc)) -> Event ValueMap
        chomp :: Context -> ValueMap -> Int -> (Int, (Arc, Arc)) -> Event ValueMap
chomp Context
c ValueMap
v Int
n' (Int
i, (Arc
w,Arc
p')) = Context -> Maybe Arc -> Arc -> ValueMap -> Event ValueMap
forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event Context
c (Arc -> Maybe Arc
forall a. a -> Maybe a
Just Arc
w) Arc
p' (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') (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') ValueMap
v)
          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
$ do Value
v' <- String -> ValueMap -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
"begin" ValueMap
v
                                     Value -> Maybe Double
getF Value
v'
                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
$ do Value
v' <- String -> ValueMap -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
"end" ValueMap
v
                                     Value -> Maybe Double
getF Value
v'
                d :: Double
d = Double
eDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
b
                b' :: Double
b' = ((Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
iDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n') Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
d) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
b
                e' :: Double
e' = ((Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
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') Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
d) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
b

{-
-- A simpler definition than the above, but this version doesn't chop
-- with multiple chops, and only works with a single 'pure' event..
_chop' :: Int -> ControlPattern -> ControlPattern
_chop' n p = begin (fromList begins) # end (fromList ends) # p
  where step = 1/(fromIntegral n)
        begins = [0,step .. (1-step)]
        ends = (tail begins) ++ [1]
-}


{-| 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
tParam Int -> ControlPattern -> ControlPattern
_striate

_striate :: Int -> ControlPattern -> ControlPattern
_striate :: Int -> ControlPattern -> ControlPattern
_striate Int
n ControlPattern
p = [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
nInt -> 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
ia -> 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
bDouble -> 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
eDouble -> 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
tParam2 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
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
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
  where offset :: Double -> ControlPattern
offset Double
i = ControlPattern
p ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> ControlPattern
P.begin (Double -> Pattern Double
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double
slot Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
i) :: Pattern Double) ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> ControlPattern
P.end (Double -> Pattern Double
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((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) :: Pattern Double)
        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


{- | `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
tParam 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
forall {a} {a}. (Fractional a, Integral a) => a -> a -> a
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 = (\Int
i Int
n -> Int -> Int -> Double
forall {a} {a}. (Fractional a, Integral a) => a -> a -> a
div' Int
i Int
n Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Int -> Int -> Double
forall {a} {a}. (Fractional a, Integral a) => a -> a -> a
div' Int
1 Int
n) (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
        div' :: a -> a -> a
div' a
num a
den = a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
num a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
den) a -> a -> a
forall a. Fractional a => a -> a -> a
/ a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
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
tParam ((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 -> 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
1Double -> 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 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
1Pattern 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
tParam3 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
countn -> 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
tParam3 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
pControlPattern -> [ControlPattern] -> [ControlPattern]
forall a. a -> [a] -> [a]
:(Integer -> ControlPattern) -> [Integer] -> [ControlPattern]
forall a b. (a -> b) -> [a] -> [b]
map (\Integer
x -> ((Integer
xInteger -> 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
countInteger -> 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
1Double -> 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
countn -> 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