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

module Sound.Tidal.Control where

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 = (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 copies :: Int
copies p :: 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 (\i :: Int
i -> let offset :: Ratio Integer
offset = Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
i Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
copies in
                     Ratio Integer
offset Ratio Integer -> ControlPattern -> ControlPattern
forall a. Ratio Integer -> Pattern a -> Pattern a
`rotL` ControlPattern
p
                     # P.pan (pure $ fromRational offset)
              )
          [0 .. (Int
copies Int -> Int -> Int
forall a. Num a => a -> a -> a
- 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 = (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 s :: Ratio Integer
s e :: Ratio Integer
e) n :: Int
n = (Int -> Arc) -> [Int] -> [Arc]
forall a b. (a -> b) -> [a] -> [b]
map (\i :: Int
i -> Ratio Integer -> Ratio Integer -> Arc
forall a. a -> a -> ArcF a
Arc (Ratio Integer
s Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
+ (Ratio Integer
eRatio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
-Ratio Integer
s)Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
*(Int -> Ratio Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
iRatio Integer -> Ratio Integer -> Ratio Integer
forall a. Fractional a => a -> a -> a
/Int -> Ratio Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)) (Ratio Integer
s Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
+ (Ratio Integer
eRatio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
-Ratio Integer
s)Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
*(Int -> Ratio Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Fractional a => a -> a -> a
/ Int -> Ratio Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n))) [0 .. Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1]

_chop :: Int -> ControlPattern -> ControlPattern
_chop :: Int -> ControlPattern -> ControlPattern
_chop n :: Int
n = ([Event ControlMap] -> [Event ControlMap])
-> ControlPattern -> ControlPattern
forall a b. ([Event a] -> [Event b]) -> Pattern a -> Pattern b
withEvents ((Event ControlMap -> [Event ControlMap])
-> [Event ControlMap] -> [Event ControlMap]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Event ControlMap -> [Event ControlMap]
chopEvent)
  where -- for each part,
        chopEvent :: Event ControlMap -> [Event ControlMap]
        chopEvent :: Event ControlMap -> [Event ControlMap]
chopEvent (Event c :: Context
c (Just w :: Arc
w) p' :: Arc
p' v :: ControlMap
v) = ((Int, (Arc, Arc)) -> Event ControlMap)
-> [(Int, (Arc, Arc))] -> [Event ControlMap]
forall a b. (a -> b) -> [a] -> [b]
map (Context
-> ControlMap -> Int -> (Int, (Arc, Arc)) -> Event ControlMap
chomp Context
c ControlMap
v ([Arc] -> 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 ControlMap])
-> [(Int, (Arc, Arc))] -> [Event ControlMap]
forall a b. (a -> b) -> a -> b
$ Arc -> Arc -> [(Int, (Arc, Arc))]
arcs Arc
w Arc
p'
        -- ignoring 'analog' events (those without wholes),
        chopEvent _ = []
        -- cut whole into n bits, and number them
        arcs :: Arc -> Arc -> [(Int, (Arc, Arc))]
arcs w' :: Arc
w' p' :: 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 p' :: Arc
p' as :: [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 (\a :: 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 -> ControlMap -> Int -> (Int, (Arc, Arc)) -> Event ControlMap
        chomp :: Context
-> ControlMap -> Int -> (Int, (Arc, Arc)) -> Event ControlMap
chomp c :: Context
c v :: ControlMap
v n' :: Int
n' (i :: Int
i, (w :: Arc
w,p' :: Arc
p')) = Context -> Maybe Arc -> Arc -> ControlMap -> Event ControlMap
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 -> ControlMap -> ControlMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert "begin" (Double -> Value
VF Double
b') (ControlMap -> ControlMap) -> ControlMap -> ControlMap
forall a b. (a -> b) -> a -> b
$ String -> Value -> ControlMap -> ControlMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert "end" (Double -> Value
VF Double
e') ControlMap
v)
          where b :: Double
b = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe Double -> Double) -> Maybe Double -> Double
forall a b. (a -> b) -> a -> b
$ do Value
v' <- String -> ControlMap -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup "begin" ControlMap
v
                                     Value -> Maybe Double
getF Value
v'
                e :: Double
e = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe 1 (Maybe Double -> Double) -> Maybe Double -> Double
forall a b. (a -> b) -> a -> b
$ do Value
v' <- String -> ControlMap -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup "end" ControlMap
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
+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, 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 = (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 n :: Int
n p :: 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 [0 .. Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1]
  where offset :: a -> ControlPattern
offset i :: a
i = (Double, Double) -> ControlMap -> ControlMap
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
+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) (ControlMap -> ControlMap) -> ControlPattern -> ControlPattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ControlPattern
p

mergePlayRange :: (Double, Double) -> ControlMap -> ControlMap
mergePlayRange :: (Double, Double) -> ControlMap -> ControlMap
mergePlayRange (b :: Double
b,e :: Double
e) cm :: ControlMap
cm = String -> Value -> ControlMap -> ControlMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert "begin" (Double -> Value
VF (Double -> Value) -> Double -> Value
forall a b. (a -> b) -> a -> b
$ (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') (ControlMap -> ControlMap) -> ControlMap -> ControlMap
forall a b. (a -> b) -> a -> b
$ String -> Value -> ControlMap -> ControlMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert "end" (Double -> Value
VF (Double -> Value) -> Double -> Value
forall a b. (a -> b) -> a -> b
$ (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') ControlMap
cm
  where b' :: Double
b' = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe Double -> Double) -> Maybe Double -> Double
forall a b. (a -> b) -> a -> b
$ String -> ControlMap -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup "begin" ControlMap
cm Maybe Value -> (Value -> Maybe Double) -> Maybe Double
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 1 (Maybe Double -> Double) -> Maybe Double -> Double
forall a b. (a -> b) -> a -> b
$ String -> ControlMap -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup "end" ControlMap
cm Maybe Value -> (Value -> Maybe Double) -> Maybe Double
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` 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 = (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

-- Old name for striateBy, here as a deprecated alias for now.
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 n :: Int
n f :: Double
f p :: 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) [0 .. Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1]
  where offset :: Double -> ControlPattern
offset i :: 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 (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 (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 = (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 n :: Int
n p :: ControlPattern
p = Ratio Integer -> ControlPattern -> ControlPattern
forall a. Ratio Integer -> Pattern a -> Pattern a
_fast (Int -> Ratio Integer
forall a. Real a => a -> Ratio Integer
toRational Int
n) ([ControlPattern] -> ControlPattern
forall a. [Pattern a] -> Pattern a
cat [ControlMap -> ControlPattern
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 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 :: Ratio Integer
-> ControlPattern -> [ControlPattern] -> ControlPattern
weave t :: Ratio Integer
t p :: ControlPattern
p ps :: [ControlPattern]
ps = Ratio Integer
-> ControlPattern
-> [ControlPattern -> ControlPattern]
-> ControlPattern
forall a.
Ratio Integer -> Pattern a -> [Pattern a -> Pattern a] -> Pattern a
weave' Ratio Integer
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 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 :: Ratio Integer -> Pattern a -> [Pattern a -> Pattern a] -> Pattern a
weaveWith t :: Ratio Integer
t p :: Pattern a
p fs :: [Pattern a -> Pattern a]
fs | Integer
l Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = Pattern a
forall a. Pattern a
silence
              | Bool
otherwise = Ratio Integer -> Pattern a -> Pattern a
forall a. Ratio Integer -> Pattern a -> Pattern a
_slow Ratio Integer
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. (a -> b) -> [a] -> [b]
map (\(i :: Int
i, f :: Pattern a -> Pattern a
f) -> (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
l) Ratio Integer -> Pattern a -> Pattern a
forall a. Ratio Integer -> Pattern a -> Pattern a
`rotL` Ratio Integer -> Pattern a -> Pattern a
forall a. Ratio Integer -> Pattern a -> Pattern a
_fast Ratio Integer
t (Pattern a -> Pattern a
f (Ratio Integer -> Pattern a -> Pattern a
forall a. Ratio Integer -> Pattern a -> Pattern a
_slow Ratio Integer
t Pattern a
p))) ([Int]
-> [Pattern a -> Pattern a] -> [(Int, Pattern a -> Pattern a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [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 (t :: * -> *) a. Foldable t => t a -> Int
length [Pattern a -> Pattern a]
fs

weave' :: Time -> Pattern a -> [Pattern a -> Pattern a] -> Pattern a
weave' :: Ratio Integer -> Pattern a -> [Pattern a -> Pattern a] -> Pattern a
weave' = Ratio Integer -> Pattern a -> [Pattern a -> Pattern a] -> Pattern a
forall a.
Ratio Integer -> 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 a :: ControlPattern
a b :: ControlPattern
b = Ratio Integer
-> ControlPattern -> [ControlPattern] -> ControlPattern
weave 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
* 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 pN :: Pattern Int
pN pI :: Pattern Int
pI p :: 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 = (\i :: Int
i n :: 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' 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' num :: a
num den :: 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 n :: Int
n i :: Int
i p :: 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 = (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
$ \n :: Int
n p :: 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
$ (\i :: 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 bits :: Int
bits ipat :: Pattern Int
ipat pat :: ControlPattern
pat = (Event ControlMap -> Event ControlMap)
-> ControlPattern -> ControlPattern
forall a b. (Event a -> Event b) -> Pattern a -> Pattern b
withEvent Event ControlMap -> Event ControlMap
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 (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 (f :: * -> *) a. Applicative f => a -> f a
pure "c")
  where f :: EventF Arc (Map k Value) -> EventF Arc (Map k Value)
f ev :: EventF Arc (Map k Value)
ev = EventF Arc (Map k Value)
ev {value :: Map k Value
value = k -> Value -> Map k Value -> Map k Value
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert "speed" (Double -> Value
VF Double
d) (EventF Arc (Map k Value) -> Map k Value
forall a b. EventF a b -> b
value EventF Arc (Map k Value)
ev)}
          where d :: Double
d = Double
sz Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Ratio Integer -> Double
forall a. Fractional a => Ratio Integer -> a
fromRational (Ratio Integer -> Double) -> Ratio Integer -> Double
forall a b. (a -> b) -> a -> b
$ (EventF Arc (Map k Value) -> Ratio Integer
forall a. Event a -> Ratio Integer
wholeStop EventF Arc (Map k Value)
ev) Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
- (EventF Arc (Map k Value) -> Ratio Integer
forall a. Event a -> Ratio Integer
wholeStart EventF Arc (Map k Value)
ev))
                sz :: Double
sz = 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 :: Pattern Int -> Pattern Int -> ControlPattern -> Pattern (Map.Map String Value)
splice :: Pattern Int -> Pattern Int -> ControlPattern -> ControlPattern
splice bitpat :: Pattern Int
bitpat ipat :: Pattern Int
ipat pat :: 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
$ (\bits :: 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"
d1 $ juxBy 0.6 (|* speed "2") $ slowspread (loopAt) [4,6,2,3] $ chop 12 $ sound "fm:14"
@
-}
loopAt :: Pattern Time -> ControlPattern -> ControlPattern
loopAt :: Pattern (Ratio Integer) -> ControlPattern -> ControlPattern
loopAt n :: Pattern (Ratio Integer)
n p :: ControlPattern
p = Pattern (Ratio Integer) -> ControlPattern -> ControlPattern
forall a. Pattern (Ratio Integer) -> Pattern a -> Pattern a
slow Pattern (Ratio Integer)
n ControlPattern
p ControlPattern -> ControlPattern -> ControlPattern
forall a. Num a => Pattern a -> Pattern a -> Pattern a
|* Pattern Double -> ControlPattern
P.speed (Ratio Integer -> Double
forall a. Fractional a => Ratio Integer -> a
fromRational (Ratio Integer -> Double)
-> Pattern (Ratio Integer) -> Pattern Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (1Pattern (Ratio Integer)
-> Pattern (Ratio Integer) -> Pattern (Ratio Integer)
forall a. Fractional a => a -> a -> a
/Pattern (Ratio Integer)
n)) ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern String -> ControlPattern
P.unit (String -> Pattern String
forall (f :: * -> *) a. Applicative f => a -> f a
pure "c")

hurry :: Pattern Rational -> ControlPattern -> ControlPattern
hurry :: Pattern (Ratio Integer) -> ControlPattern -> ControlPattern
hurry !Pattern (Ratio Integer)
x = (ControlPattern -> ControlPattern -> ControlPattern
forall a. Num a => Pattern a -> Pattern a -> Pattern a
|* Pattern Double -> ControlPattern
P.speed (Ratio Integer -> Double
forall a. Fractional a => Ratio Integer -> a
fromRational (Ratio Integer -> Double)
-> Pattern (Ratio Integer) -> Pattern Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern (Ratio Integer)
x)) (ControlPattern -> ControlPattern)
-> (ControlPattern -> ControlPattern)
-> ControlPattern
-> ControlPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern (Ratio Integer) -> ControlPattern -> ControlPattern
forall a. Pattern (Ratio Integer) -> Pattern a -> Pattern a
fast Pattern (Ratio Integer)
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 ControlMap
smash :: Pattern Int
-> [Pattern (Ratio Integer)] -> ControlPattern -> ControlPattern
smash n :: Pattern Int
n xs :: [Pattern (Ratio Integer)]
xs p :: ControlPattern
p = [ControlPattern] -> ControlPattern
forall a. [Pattern a] -> Pattern a
slowcat ([ControlPattern] -> ControlPattern)
-> [ControlPattern] -> ControlPattern
forall a b. (a -> b) -> a -> b
$ (Pattern (Ratio Integer) -> ControlPattern)
-> [Pattern (Ratio Integer)] -> [ControlPattern]
forall a b. (a -> b) -> [a] -> [b]
map (Pattern (Ratio Integer) -> ControlPattern -> ControlPattern
forall a. Pattern (Ratio Integer) -> Pattern a -> Pattern a
`slow` ControlPattern
p') [Pattern (Ratio Integer)]
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 -> Pattern ControlMap
smash' :: Int
-> [Pattern (Ratio Integer)] -> ControlPattern -> ControlPattern
smash' n :: Int
n xs :: [Pattern (Ratio Integer)]
xs p :: ControlPattern
p = [ControlPattern] -> ControlPattern
forall a. [Pattern a] -> Pattern a
slowcat ([ControlPattern] -> ControlPattern)
-> [ControlPattern] -> ControlPattern
forall a b. (a -> b) -> a -> b
$ (Pattern (Ratio Integer) -> ControlPattern)
-> [Pattern (Ratio Integer)] -> [ControlPattern]
forall a b. (a -> b) -> [a] -> [b]
map (Pattern (Ratio Integer) -> ControlPattern -> ControlPattern
forall a. Pattern (Ratio Integer) -> Pattern a -> Pattern a
`slow` ControlPattern
p') [Pattern (Ratio Integer)]
xs
  where p' :: ControlPattern
p' = Int -> ControlPattern -> ControlPattern
_chop Int
n ControlPattern
p


{- | Stut applies a type of delay to a pattern. It has three parameters,
which could be called depth, feedback and time. Depth is an integer
and the others floating point. This adds a bit of echo:

@
d1 $ stut 4 0.5 0.2 $ sound "bd sn"
@

The above results in 4 echos, each one 50% quieter than the last,
with 1/5th of a cycle between them. It is possible to reverse the echo:

@
d1 $ stut 4 0.5 (-0.2) $ sound "bd sn"
@
-}

stut :: Pattern Integer -> Pattern Double -> Pattern Rational -> ControlPattern -> ControlPattern
stut :: Pattern Integer
-> Pattern Double
-> Pattern (Ratio Integer)
-> ControlPattern
-> ControlPattern
stut = (Integer
 -> Double -> Ratio Integer -> ControlPattern -> ControlPattern)
-> Pattern Integer
-> Pattern Double
-> Pattern (Ratio Integer)
-> 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 -> Ratio Integer -> ControlPattern -> ControlPattern
_stut

_stut :: Integer -> Double -> Rational -> ControlPattern -> ControlPattern
_stut :: Integer
-> Double -> Ratio Integer -> ControlPattern -> ControlPattern
_stut count :: Integer
count feedback :: Double
feedback steptime :: Ratio Integer
steptime p :: 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 (\x :: Integer
x -> ((Integer
xInteger -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
%1)Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
*Ratio Integer
steptime) Ratio Integer -> ControlPattern -> ControlPattern
forall a. Ratio Integer -> 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 (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)))) [1..(Integer
countInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-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
*(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
-)

{- | Instead of just decreasing volume to produce echoes, @stut'@ allows to apply a function for each step and overlays the result delayed by the given time.

@
d1 $ stut' 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.
-}
stutWith :: Pattern Int -> Pattern Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
stutWith :: Pattern Int
-> Pattern (Ratio Integer)
-> (Pattern a -> Pattern a)
-> Pattern a
-> Pattern a
stutWith n :: Pattern Int
n t :: Pattern (Ratio Integer)
t f :: Pattern a -> Pattern a
f p :: 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
$ (\a :: Int
a b :: Ratio Integer
b -> Int
-> Ratio Integer
-> (Pattern a -> Pattern a)
-> Pattern a
-> Pattern a
forall n a.
(Num n, Ord n) =>
n
-> Ratio Integer
-> (Pattern a -> Pattern a)
-> Pattern a
-> Pattern a
_stutWith Int
a Ratio Integer
b Pattern a -> Pattern a
f Pattern a
p) (Int -> Ratio Integer -> Pattern a)
-> Pattern Int -> Pattern (Ratio Integer -> Pattern a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Int
n Pattern (Ratio Integer -> Pattern a)
-> Pattern (Ratio Integer) -> Pattern (Pattern a)
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
<* Pattern (Ratio Integer)
t

_stutWith :: (Num n, Ord n) => n -> Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_stutWith :: n
-> Ratio Integer
-> (Pattern a -> Pattern a)
-> Pattern a
-> Pattern a
_stutWith count :: n
count steptime :: Ratio Integer
steptime f :: Pattern a -> Pattern a
f p :: Pattern a
p | n
count n -> n -> Bool
forall a. Ord a => a -> a -> Bool
<= 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 (Ratio Integer
steptime Ratio Integer -> Pattern a -> Pattern a
forall a. Ratio Integer -> Pattern a -> Pattern a
`rotR` n
-> Ratio Integer
-> (Pattern a -> Pattern a)
-> Pattern a
-> Pattern a
forall n a.
(Num n, Ord n) =>
n
-> Ratio Integer
-> (Pattern a -> Pattern a)
-> Pattern a
-> Pattern a
_stutWith (n
countn -> n -> n
forall a. Num a => a -> a -> a
-1) Ratio Integer
steptime Pattern a -> Pattern a
f Pattern a
p)) Pattern a
p

-- | The old name for stutWith
stut' :: Pattern Int -> Pattern Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
stut' :: Pattern Int
-> Pattern (Ratio Integer)
-> (Pattern a -> Pattern a)
-> Pattern a
-> Pattern a
stut' = Pattern Int
-> Pattern (Ratio Integer)
-> (Pattern a -> Pattern a)
-> Pattern a
-> Pattern a
forall a.
Pattern Int
-> Pattern (Ratio Integer)
-> (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 :: Pattern a -> Pattern a
sec p :: 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 1 "_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 :: Pattern a -> Pattern a
msec p :: 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
/1000)) (Double -> a) -> Pattern Double -> Pattern a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Double -> String -> Pattern Double
cF 1 "_cps") Pattern a -> Pattern a -> Pattern a
forall a. Num a => Pattern a -> Pattern a -> Pattern a
*| Pattern a
p

_trigger :: Show a => Bool -> a -> Pattern b -> Pattern b
_trigger :: Bool -> a -> Pattern b -> Pattern b
_trigger quant :: Bool
quant k :: a
k pat :: Pattern b
pat = Pattern b
pat {query :: Query b
query = Query b
q}
  where q :: Query b
q st :: State
st = Pattern b -> Query b
forall a. Pattern a -> Query a
query ((State -> Pattern (Ratio Integer)
offset State
st) Pattern (Ratio Integer) -> Pattern b -> Pattern b
forall a. Pattern (Ratio Integer) -> Pattern a -> Pattern a
~> Pattern b
pat) State
st
        f :: Ratio Integer -> Ratio Integer
f | Bool
quant = (Int -> Ratio Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Rational) (Int -> Ratio Integer)
-> (Ratio Integer -> Int) -> Ratio Integer -> Ratio Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ratio Integer -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round
          | Bool
otherwise = Ratio Integer -> Ratio Integer
forall a. a -> a
id
        offset :: State -> Pattern (Ratio Integer)
offset st :: State
st = Pattern (Ratio Integer)
-> Maybe (Pattern (Ratio Integer)) -> Pattern (Ratio Integer)
forall a. a -> Maybe a -> a
fromMaybe (Ratio Integer -> Pattern (Ratio Integer)
forall (f :: * -> *) a. Applicative f => a -> f a
pure 0) (Maybe (Pattern (Ratio Integer)) -> Pattern (Ratio Integer))
-> Maybe (Pattern (Ratio Integer)) -> Pattern (Ratio Integer)
forall a b. (a -> b) -> a -> b
$ do Pattern Value
p <- String -> Map String (Pattern Value) -> Maybe (Pattern Value)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
ctrl (State -> Map String (Pattern Value)
controls State
st)
                                            Pattern (Ratio Integer) -> Maybe (Pattern (Ratio Integer))
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern (Ratio Integer) -> Maybe (Pattern (Ratio Integer)))
-> Pattern (Ratio Integer) -> Maybe (Pattern (Ratio Integer))
forall a b. (a -> b) -> a -> b
$ ((Ratio Integer -> Ratio Integer
f (Ratio Integer -> Ratio Integer)
-> (Value -> Ratio Integer) -> Value -> Ratio Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ratio Integer -> Maybe (Ratio Integer) -> Ratio Integer
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe (Ratio Integer) -> Ratio Integer)
-> (Value -> Maybe (Ratio Integer)) -> Value -> Ratio Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Maybe (Ratio Integer)
getR) (Value -> Ratio Integer)
-> Pattern Value -> Pattern (Ratio Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Value
p)
        ctrl :: String
ctrl = "_t_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
k

trigger :: Show a => a -> Pattern b -> Pattern b
trigger :: a -> Pattern b -> Pattern b
trigger = Bool -> a -> Pattern b -> Pattern b
forall a b. Show a => Bool -> a -> Pattern b -> Pattern b
_trigger Bool
False

qtrigger :: Show a => a -> Pattern b -> Pattern b
qtrigger :: a -> Pattern b -> Pattern b
qtrigger = Bool -> a -> Pattern b -> Pattern b
forall a b. Show a => Bool -> a -> Pattern b -> Pattern b
_trigger Bool
True

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

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

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