{-# 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.UI
import qualified Sound.Tidal.Params as P
import Sound.Tidal.Utils

{- | `spin` will "spin" a layer up a pattern the given number of times,
with each successive layer offset in time by an additional `1/n` of a
cycle, and panned by an additional `1/n`. The result is a pattern that
seems to spin around. This function works best on multichannel
systems.

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



{- | `chop` granualizes every sample in place as it is played, turning a pattern of samples into a pattern of sample parts. Use an integer value to specify how many granules each sample is chopped into:

@
d1 $ chop 16 $ sound "arpy arp feel*4 arpy*4"
@

Different values of `chop` can yield very different results, depending
on the samples used:


@
d1 $ chop 16 $ sound (samples "arpy*8" (run 16))
d1 $ chop 32 $ sound (samples "arpy*8" (run 16))
d1 $ chop 256 $ sound "bd*4 [sn cp] [hh future]*2 [cp feel]"
@
-}

chop :: Pattern Int -> ControlPattern -> ControlPattern
chop :: Pattern Int -> ControlPattern -> ControlPattern
chop = 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 = forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> forall a. a -> a -> ArcF a
Arc (Time
s forall a. Num a => a -> a -> a
+ (Time
eforall a. Num a => a -> a -> a
-Time
s)forall a. Num a => a -> a -> a
*(forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
iforall a. Fractional a => a -> a -> a
/forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)) (Time
s forall a. Num a => a -> a -> a
+ (Time
eforall a. Num a => a -> a -> a
-Time
s)forall a. Num a => a -> a -> a
*(forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
iforall a. Num a => a -> a -> a
+Int
1) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n))) [Int
0 .. Int
nforall a. Num a => a -> a -> a
-Int
1]

_chop :: Int -> ControlPattern -> ControlPattern
_chop :: Int -> ControlPattern -> ControlPattern
_chop Int
n = forall a b. ([Event a] -> [Event b]) -> Pattern a -> Pattern b
withEvents (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) = forall a b. (a -> b) -> [a] -> [b]
map (Context -> ValueMap -> Int -> (Int, (Arc, Arc)) -> Event ValueMap
chomp Context
c ValueMap
v (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ Arc -> Int -> [Arc]
chopArc Arc
w Int
n)) 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' 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 = forall a b. (a -> b) -> [a] -> [b]
map ((forall a. HasCallStack => Maybe a -> a
fromJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [(Int, a)]
enumerate forall a b. (a -> b) -> a -> b
$ 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')) = forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event Context
c (forall a. a -> Maybe a
Just Arc
w) Arc
p' (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
"begin" (Double -> Value
VF Double
b') forall a b. (a -> b) -> a -> b
$ 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 = forall a. a -> Maybe a -> a
fromMaybe Double
0 forall a b. (a -> b) -> a -> b
$ do Value
v' <- 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 = forall a. a -> Maybe a -> a
fromMaybe Double
1 forall a b. (a -> b) -> a -> b
$ do Value
v' <- 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
eforall a. Num a => a -> a -> a
-Double
b
                b' :: Double
b' = ((forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
iforall a. Fractional a => a -> a -> a
/forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n') forall a. Num a => a -> a -> a
* Double
d) forall a. Num a => a -> a -> a
+ Double
b
                e' :: Double
e' = ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
iforall a. Num a => a -> a -> a
+Int
1) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n') forall a. Num a => a -> a -> a
* Double
d) 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, for example:

@
d1 $ striate 3 $ sound "ho ho:2 ho:3 hc"
@

This plays the loop the given number of times, but triggering
progressive portions of each sample. So in this case it plays the loop
three times, the first time playing the first third of each sample,
then the second time playing the second third of each sample, etc..
With the highhat samples in the above example it sounds a bit like
reverb, but it isn't really.

You can also use striate with very long samples, to cut it into short
chunks and pattern those chunks. This is where things get towards
granular synthesis. The following cuts a sample into 128 parts, plays
it over 8 cycles and manipulates those parts by reversing and rotating
the loops.

@
d1 $  slow 8 $ striate 128 $ sound "bev"
@
-}

striate :: Pattern Int -> ControlPattern -> ControlPattern
striate :: Pattern Int -> ControlPattern -> ControlPattern
striate = 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 = forall a. [Pattern a] -> Pattern a
fastcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Integral a => a -> ControlPattern
offset [Int
0 .. Int
nforall a. Num a => a -> a -> a
-Int
1]
  where offset :: a -> ControlPattern
offset a
i = (Double, Double) -> ValueMap -> ValueMap
mergePlayRange (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n, forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
iforall a. Num a => a -> a -> a
+a
1) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) 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 = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
"begin" (Double -> Value
VF ((Double
bforall a. Num a => a -> a -> a
*Double
d')forall a. Num a => a -> a -> a
+Double
b')) forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
"end" (Double -> Value
VF ((Double
eforall a. Num a => a -> a -> a
*Double
d')forall a. Num a => a -> a -> a
+Double
b')) ValueMap
cm
  where b' :: Double
b' = forall a. a -> Maybe a -> a
fromMaybe Double
0 forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
"begin" ValueMap
cm forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Maybe Double
getF
        e' :: Double
e' = forall a. a -> Maybe a -> a
fromMaybe Double
1 forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
"end" ValueMap
cm forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Maybe Double
getF
        d' :: Double
d' = Double
e' 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` uses the `begin` and `end` parameters
internally. This means that if you're using `striate` (or `striateBy`)
you probably shouldn't also specify `begin` or `end`. -}
striateBy :: Pattern Int -> Pattern Double -> ControlPattern -> ControlPattern
striateBy :: Pattern Int -> Pattern Double -> ControlPattern -> ControlPattern
striateBy = 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 = forall a. [Pattern a] -> Pattern a
fastcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Double -> ControlPattern
offset forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) [Int
0 .. Int
nforall a. Num a => a -> a -> a
-Int
1]
  where offset :: Double -> ControlPattern
offset Double
i = ControlPattern
p forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> ControlPattern
P.begin (forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double
slot forall a. Num a => a -> a -> a
* Double
i) :: Pattern Double) forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> ControlPattern
P.end (forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Double
slot forall a. Num a => a -> a -> a
* Double
i) forall a. Num a => a -> a -> a
+ Double
f) :: Pattern Double)
        slot :: Double
slot = (Double
1 forall a. Num a => a -> a -> a
- Double
f) forall a. Fractional a => a -> a -> a
/ 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 = 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 = forall a. Time -> Pattern a -> Pattern a
_fast (forall a. Real a => a -> Time
toRational Int
n) (forall a. [Pattern a] -> Pattern a
cat [forall (f :: * -> *) a. Applicative f => a -> f a
pure ValueMap
1, forall a. Pattern a
silence]) forall (a :: * -> *) b.
(Applicative a, Unionable b) =>
a b -> a b -> a b
|>| Int -> ControlPattern -> ControlPattern
_chop Int
n ControlPattern
p

{- |
`weave` applies a function smoothly over an array of different patterns. It uses an `OscPattern` to
apply the function at different levels to each pattern, creating a weaving effect.

@
d1 $ weave 3 (shape $ sine1) [sound "bd [sn drum:2*2] bd*2 [sn drum:1]", sound "arpy*8 ~"]
@
-}
weave :: Time -> ControlPattern -> [ControlPattern] -> ControlPattern
weave :: Time -> ControlPattern -> [ControlPattern] -> ControlPattern
weave Time
t ControlPattern
p [ControlPattern]
ps = forall a.
Time -> Pattern a -> [Pattern a -> Pattern a] -> Pattern a
weave' Time
t ControlPattern
p (forall a b. (a -> b) -> [a] -> [b]
map forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
(#) [ControlPattern]
ps)


{- | `weaveWith` is similar in that it blends functions at the same time at different amounts over a pattern:

@
d1 $ weaveWith 3 (sound "bd [sn drum:2*2] bd*2 [sn drum:1]") [density 2, (# speed "0.5"), chop 16]
@
-}
weaveWith :: 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 forall a. Eq a => a -> a -> Bool
== Integer
0 = forall a. Pattern a
silence
              | Bool
otherwise = forall a. Time -> Pattern a -> Pattern a
_slow Time
t forall a b. (a -> b) -> a -> b
$ forall a. [Pattern a] -> Pattern a
stack forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\ Int
i Pattern a -> Pattern a
f -> (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i forall a. Integral a => a -> a -> Ratio a
% Integer
l) forall a. Time -> Pattern a -> Pattern a
`rotL` forall a. Time -> Pattern a -> Pattern a
_fast Time
t (Pattern a -> Pattern a
f (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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pattern a -> Pattern a]
fs

weave' :: Time -> Pattern a -> [Pattern a -> Pattern a] -> Pattern a
weave' :: forall a.
Time -> Pattern a -> [Pattern a -> Pattern a] -> Pattern a
weave' = 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 (forall a. Fractional a => Pattern a
sine 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 :: 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 forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> ControlPattern
P.end Pattern Double
e forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# ControlPattern
p
  where b :: Pattern Double
b = forall {a} {a}. (Fractional a, Integral a) => a -> a -> a
div' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Int
pI forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
<* Pattern Int
pN
        e :: Pattern Double
e = (\Int
i Int
n -> forall {a} {a}. (Fractional a, Integral a) => a -> a -> a
div' Int
i Int
n forall a. Num a => a -> a -> a
+ forall {a} {a}. (Fractional a, Integral a) => a -> a -> a
div' Int
1 Int
n) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Int
pI forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
<* Pattern Int
pN
        div' :: a -> a -> a
div' a
num a
den = forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
num forall a. Integral a => a -> a -> a
`mod` a
den) forall a. Fractional 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 :: Pattern Int -> ControlPattern -> ControlPattern
randslice :: Pattern Int -> ControlPattern -> ControlPattern
randslice = forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam forall a b. (a -> b) -> a -> b
$ \Int
n ControlPattern
p -> forall a. Pattern (Pattern a) -> Pattern a
innerJoin forall a b. (a -> b) -> a -> b
$ (\Int
i -> Int -> Int -> ControlPattern -> ControlPattern
_slice Int
n Int
i ControlPattern
p) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall a b. (Event a -> Event b) -> Pattern a -> Pattern b
withEvent forall {k}.
(Ord k, IsString k) =>
Event (Map k Value) -> Event (Map k Value)
f (Pattern Int -> Pattern Int -> ControlPattern -> ControlPattern
slice (forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
bits) Pattern Int
ipat ControlPattern
pat) forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern String -> ControlPattern
P.unit (forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"c")
  where f :: Event (Map k Value) -> Event (Map k Value)
f Event (Map k Value)
ev = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
"speed" (forall a b. EventF a b -> b
value Event (Map k Value)
ev) of
                        (Just (VF Double
s)) -> Event (Map k Value)
ev {value :: Map k Value
value = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
"speed" (Double -> Value
VF forall a b. (a -> b) -> a -> b
$ Double
dforall a. Num a => a -> a -> a
*Double
s) (forall a b. EventF a b -> b
value Event (Map k Value)
ev)}  -- if there is a speed parameter already present
                        Maybe Value
_ -> Event (Map k Value)
ev {value :: Map k Value
value = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
"speed" (Double -> Value
VF Double
d) (forall a b. EventF a b -> b
value Event (Map k Value)
ev)}
          where d :: Double
d = Double
sz forall a. Fractional a => a -> a -> a
/ forall a. Fractional a => Time -> a
fromRational (forall a. Event a -> Time
wholeStop Event (Map k Value)
ev forall a. Num a => a -> a -> a
- forall a. Event a -> Time
wholeStart Event (Map k Value)
ev)
                sz :: Double
sz = Double
1forall a. Fractional a => a -> a -> a
/forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bits

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 = forall a. Pattern (Pattern a) -> Pattern a
innerJoin forall a b. (a -> b) -> a -> b
$ (\Int
bits -> Int -> Pattern Int -> ControlPattern -> ControlPattern
_splice Int
bits Pattern Int
ipat ControlPattern
pat) 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"
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 = forall a. Pattern Time -> Pattern a -> Pattern a
slow Pattern Time
n ControlPattern
p forall a. Num a => Pattern a -> Pattern a -> Pattern a
|* Pattern Double -> ControlPattern
P.speed (forall a. Fractional a => Time -> a
fromRational forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Pattern Time
1forall a. Fractional a => a -> a -> a
/Pattern Time
n)) forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern String -> ControlPattern
P.unit (forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"c")

hurry :: Pattern Rational -> ControlPattern -> ControlPattern
hurry :: Pattern Time -> ControlPattern -> ControlPattern
hurry !Pattern Time
x = (forall a. Num a => Pattern a -> Pattern a -> Pattern a
|* Pattern Double -> ControlPattern
P.speed (forall a. Fractional a => Time -> a
fromRational forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Time
x)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. [Pattern a] -> Pattern a
slowcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (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 to `smash` is `smash'` which will use `chop` instead of `striate`.
-}
smash' :: Int -> [Pattern Time] -> ControlPattern -> ControlPattern
smash' :: Int -> [Pattern Time] -> ControlPattern -> ControlPattern
smash' Int
n [Pattern Time]
xs ControlPattern
p = forall a. [Pattern a] -> Pattern a
slowcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (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.

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

{- |
    Allows to apply a function for 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.
-}
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 = forall a. Pattern (Pattern a) -> Pattern a
innerJoin forall a b. (a -> b) -> a -> b
$ (\Int
a Time
b -> 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) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Int
n 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 forall a. Ord a => a -> a -> Bool
<= n
1 = Pattern a
p
                         | Bool
otherwise = forall a. Pattern a -> Pattern a -> Pattern a
overlay (Pattern a -> Pattern a
f (Time
time forall a. Time -> Pattern a -> Pattern a
`rotR` forall n a.
(Num n, Ord n) =>
n -> Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_echoWith (n
countforall 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 = 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 = forall a. [Pattern a] -> Pattern a
stack (ControlPattern
pforall a. a -> [a] -> [a]
:forall a b. (a -> b) -> [a] -> [b]
map (\Integer
x -> ((Integer
xforall a. Integral a => a -> a -> Ratio a
%Integer
1)forall a. Num a => a -> a -> a
*Time
steptime) forall a. Time -> Pattern a -> Pattern a
`rotR` (ControlPattern
p forall a. Num a => Pattern a -> Pattern a -> Pattern a
|* Pattern Double -> ControlPattern
P.gain (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Double
scalegain (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)))) [Integer
1..(Integer
countforall a. Num a => a -> a -> a
-Integer
1)])
  where scalegain :: Double -> Double
scalegain
          = (forall a. Num a => a -> a -> a
+Double
feedback) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
*(Double
1forall a. Num a => a -> a -> a
-Double
feedback)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
count) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
count 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 = forall a. Pattern (Pattern a) -> Pattern a
innerJoin forall a b. (a -> b) -> a -> b
$ (\Int
a Time
b -> 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) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Int
n 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 forall a. Ord a => a -> a -> Bool
<= n
1 = Pattern a
p
                             | Bool
otherwise = forall a. Pattern a -> Pattern a -> Pattern a
overlay (Pattern a -> Pattern a
f (Time
steptime forall a. Time -> Pattern a -> Pattern a
`rotR` forall n a.
(Num n, Ord n) =>
n -> Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_stutWith (n
countforall 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' = 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 = (forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Double -> String -> Pattern Double
cF Double
1 String
"_cps") 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 = (forall a b. (Real a, Fractional b) => a -> b
realToFrac forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Fractional a => a -> a -> a
/Double
1000) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Double -> String -> Pattern Double
cF Double
1 String
"_cps") forall a. Num a => Pattern a -> Pattern a -> Pattern a
*| Pattern a
p

triggerWith :: Show a => (Time -> Time) -> a -> Pattern b -> Pattern b
triggerWith :: forall a b. Show a => (Time -> Time) -> a -> Pattern b -> Pattern b
triggerWith Time -> Time
f a
k Pattern b
pat = Pattern b
pat {query :: State -> [Event b]
query = State -> [Event b]
q}
  where q :: State -> [Event b]
q State
st = forall a. Pattern a -> State -> [Event a]
query (forall a. Time -> Pattern a -> Pattern a
rotR (State -> Time
offset State
st) Pattern b
pat) State
st
        offset :: State -> Time
offset State
st = forall a. a -> Maybe a -> a
fromMaybe Time
0 forall a b. (a -> b) -> a -> b
$ do Value
v <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
ctrl (State -> ValueMap
controls State
st)
                                     forall (m :: * -> *) a. Monad m => a -> m a
return (Time -> Time
f forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Time
0 forall a b. (a -> b) -> a -> b
$ Value -> Maybe Time
getR Value
v)
        ctrl :: String
ctrl = String
"_t_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
k

trigger :: Show a => a -> Pattern b -> Pattern b
trigger :: forall a b. Show a => a -> Pattern b -> Pattern b
trigger = forall a b. Show a => (Time -> Time) -> a -> Pattern b -> Pattern b
triggerWith forall a. a -> a
id

ctrigger :: Show a => a -> Pattern b -> Pattern b
ctrigger :: forall a b. Show a => a -> Pattern b -> Pattern b
ctrigger = forall a b. Show a => (Time -> Time) -> a -> Pattern b -> Pattern b
triggerWith forall a b. (a -> b) -> a -> b
$ (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Rational) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (RealFrac a, Integral b) => a -> b
ceiling

qtrigger :: Show a => a -> Pattern b -> Pattern b
qtrigger :: forall a b. Show a => a -> Pattern b -> Pattern b
qtrigger = forall a b. Show a => a -> Pattern b -> Pattern b
ctrigger

rtrigger :: Show a => a -> Pattern b -> Pattern b
rtrigger :: forall a b. Show a => a -> Pattern b -> Pattern b
rtrigger = forall a b. Show a => (Time -> Time) -> a -> Pattern b -> Pattern b
triggerWith forall a b. (a -> b) -> a -> b
$ (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Rational) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (RealFrac a, Integral b) => a -> b
round

ftrigger :: Show a => a -> Pattern b -> Pattern b
ftrigger :: forall a b. Show a => a -> Pattern b -> Pattern b
ftrigger = forall a b. Show a => (Time -> Time) -> a -> Pattern b -> Pattern b
triggerWith forall a b. (a -> b) -> a -> b
$ (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Rational) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (RealFrac a, Integral b) => a -> b
floor

qt :: Show a => a -> Pattern b -> Pattern b
qt :: forall a b. Show a => a -> Pattern b -> Pattern b
qt = forall a b. Show a => a -> Pattern b -> Pattern b
qtrigger

reset :: Show a => a -> Pattern b -> Pattern b
reset :: forall a b. Show a => a -> Pattern b -> Pattern b
reset a
k Pattern b
pat = Pattern b
pat {query :: State -> [Event b]
query = State -> [Event b]
q}
  where q :: State -> [Event b]
q State
st = forall a. Pattern a -> State -> [Event a]
query (forall a. Time -> Pattern a -> Pattern a
rotR (State -> Time
offset State
st) forall a b. (a -> b) -> a -> b
$ forall a.
(Int -> Bool) -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
when (forall a. Ord a => a -> a -> Bool
<=Int
0) (forall a b. a -> b -> a
const forall a. Pattern a
silence) Pattern b
pat) State
st
        f :: Time -> Time
f = (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Rational) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (RealFrac a, Integral b) => a -> b
floor
        offset :: State -> Time
offset State
st = forall a. a -> Maybe a -> a
fromMaybe Time
0 forall a b. (a -> b) -> a -> b
$ do Value
p <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
ctrl (State -> ValueMap
controls State
st)
                                     forall (m :: * -> *) a. Monad m => a -> m a
return (Time -> Time
f forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Time
0 forall a b. (a -> b) -> a -> b
$ Value -> Maybe Time
getR Value
p)
        ctrl :: String
ctrl = String
"_t_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
k

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 forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# forall a. Pattern Int -> Pattern Int -> Pattern a -> Pattern a
bite Pattern Int
1 (forall a b. a -> b -> a
const Int
0 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ControlPattern
pat) ControlPattern
epat