{-# 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 = (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 :: 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)
              )
          [Int
0 .. (Int
copies Int -> Int -> Int
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 = (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 Ratio Integer
s Ratio Integer
e) Int
n = (Int -> Arc) -> [Int] -> [Arc]
forall a b. (a -> b) -> [a] -> [b]
map (\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
+Int
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))) [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 (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, 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 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 (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 (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 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 (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 = (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 = 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 [ValueMap -> ControlPattern
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 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 Ratio Integer
t ControlPattern
p [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 Ratio Integer
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 = 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 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 -> 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
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 ControlPattern
a ControlPattern
b = Ratio Integer
-> ControlPattern -> [ControlPattern] -> ControlPattern
weave Ratio Integer
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 :: 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 :: 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 (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 String
"c")
  where f :: EventF Arc (Map k Value) -> EventF Arc (Map k Value)
f 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 k
"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 (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 = 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 :: 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"
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 Pattern (Ratio Integer)
n 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
<$> (Pattern (Ratio Integer)
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 String
"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 ValueMap
smash :: Pattern Int
-> [Pattern (Ratio Integer)] -> ControlPattern -> ControlPattern
smash Pattern Int
n [Pattern (Ratio Integer)]
xs 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 -> ControlPattern
smash' :: Int
-> [Pattern (Ratio Integer)] -> ControlPattern -> ControlPattern
smash' Int
n [Pattern (Ratio Integer)]
xs 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 Integer
count Double
feedback Ratio Integer
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 -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
%Integer
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)))) [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
-)

{- | 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 Pattern Int
n Pattern (Ratio Integer)
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 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 n
count Ratio Integer
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 (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
-n
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 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 :: 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

triggerWith :: Show a => (Time -> Time) -> a -> Pattern b -> Pattern b
triggerWith :: (Ratio Integer -> Ratio Integer) -> a -> Pattern b -> Pattern b
triggerWith Ratio Integer -> Ratio Integer
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 = Pattern b -> State -> [Event b]
forall a. Pattern a -> State -> [Event a]
query (Ratio Integer -> Pattern b -> Pattern b
forall a. Ratio Integer -> Pattern a -> Pattern a
rotR (State -> Ratio Integer
offset State
st) Pattern b
pat) State
st
        offset :: State -> Ratio Integer
offset State
st = Ratio Integer -> Maybe (Ratio Integer) -> Ratio Integer
forall a. a -> Maybe a -> a
fromMaybe Ratio Integer
0 (Maybe (Ratio Integer) -> Ratio Integer)
-> Maybe (Ratio Integer) -> Ratio Integer
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
ctrl (State -> ValueMap
controls State
st)
                                     Ratio Integer -> Maybe (Ratio Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ratio Integer -> Ratio Integer
f (Ratio Integer -> Ratio Integer) -> Ratio Integer -> Ratio Integer
forall a b. (a -> b) -> a -> b
$ Ratio Integer -> Maybe (Ratio Integer) -> Ratio Integer
forall a. a -> Maybe a -> a
fromMaybe Ratio Integer
0 (Maybe (Ratio Integer) -> Ratio Integer)
-> Maybe (Ratio Integer) -> Ratio Integer
forall a b. (a -> b) -> a -> b
$ Value -> Maybe (Ratio Integer)
getR Value
v)
        ctrl :: String
ctrl = String
"_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 = (Ratio Integer -> Ratio Integer) -> a -> Pattern b -> Pattern b
forall a b.
Show a =>
(Ratio Integer -> Ratio Integer) -> a -> Pattern b -> Pattern b
triggerWith Ratio Integer -> Ratio Integer
forall a. a -> a
id

ctrigger :: Show a => a -> Pattern b -> Pattern b
ctrigger :: a -> Pattern b -> Pattern b
ctrigger = (Ratio Integer -> Ratio Integer) -> a -> Pattern b -> Pattern b
forall a b.
Show a =>
(Ratio Integer -> Ratio Integer) -> a -> Pattern b -> Pattern b
triggerWith ((Ratio Integer -> Ratio Integer) -> a -> Pattern b -> Pattern b)
-> (Ratio Integer -> Ratio Integer) -> a -> Pattern b -> Pattern b
forall a b. (a -> b) -> a -> b
$ (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
ceiling

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

rtrigger :: Show a => a -> Pattern b -> Pattern b
rtrigger :: a -> Pattern b -> Pattern b
rtrigger = (Ratio Integer -> Ratio Integer) -> a -> Pattern b -> Pattern b
forall a b.
Show a =>
(Ratio Integer -> Ratio Integer) -> a -> Pattern b -> Pattern b
triggerWith ((Ratio Integer -> Ratio Integer) -> a -> Pattern b -> Pattern b)
-> (Ratio Integer -> Ratio Integer) -> a -> Pattern b -> Pattern b
forall a b. (a -> b) -> a -> b
$ (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

ftrigger :: Show a => a -> Pattern b -> Pattern b
ftrigger :: a -> Pattern b -> Pattern b
ftrigger = (Ratio Integer -> Ratio Integer) -> a -> Pattern b -> Pattern b
forall a b.
Show a =>
(Ratio Integer -> Ratio Integer) -> a -> Pattern b -> Pattern b
triggerWith ((Ratio Integer -> Ratio Integer) -> a -> Pattern b -> Pattern b)
-> (Ratio Integer -> Ratio Integer) -> a -> Pattern b -> Pattern b
forall a b. (a -> b) -> a -> b
$ (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

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 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 = Pattern b -> State -> [Event b]
forall a. Pattern a -> State -> [Event a]
query (Ratio Integer -> Pattern b -> Pattern b
forall a. Ratio Integer -> Pattern a -> Pattern a
rotR (State -> Ratio Integer
offset State
st) (Pattern b -> Pattern b) -> Pattern b -> Pattern b
forall a b. (a -> b) -> a -> b
$ (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
<=Int
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 -> Ratio Integer
offset State
st = Ratio Integer -> Maybe (Ratio Integer) -> Ratio Integer
forall a. a -> Maybe a -> a
fromMaybe Ratio Integer
0 (Maybe (Ratio Integer) -> Ratio Integer)
-> Maybe (Ratio Integer) -> Ratio Integer
forall a b. (a -> b) -> a -> b
$ do Value
p <- String -> ValueMap -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
ctrl (State -> ValueMap
controls State
st)
                                     Ratio Integer -> Maybe (Ratio Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ratio Integer -> Ratio Integer
f (Ratio Integer -> Ratio Integer) -> Ratio Integer -> Ratio Integer
forall a b. (a -> b) -> a -> b
$ Ratio Integer -> Maybe (Ratio Integer) -> Ratio Integer
forall a. a -> Maybe a -> a
fromMaybe Ratio Integer
0 (Maybe (Ratio Integer) -> Ratio Integer)
-> Maybe (Ratio Integer) -> Ratio Integer
forall a b. (a -> b) -> a -> b
$ Value -> Maybe (Ratio Integer)
getR Value
p)
        ctrl :: String
ctrl = String
"_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 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