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

module Sound.Tidal.UI where

{-
    UI.hs - Tidal's main 'user interface' functions, for transforming
    patterns, building on the Core ones.
    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           Data.Char (digitToInt, isDigit, ord)
import           Data.Bits (testBit, Bits, xor, shiftL, shiftR)

import           Data.Ratio ((%), Ratio)
import           Data.Fixed (mod')
import           Data.List (sort, sortOn, findIndices, elemIndex, groupBy, transpose, intercalate, findIndex)
import           Data.Maybe (isJust, fromJust, fromMaybe, mapMaybe)
import qualified Data.Text as T
import qualified Data.Map.Strict as Map
import           Data.Bool (bool)

import           Sound.Tidal.Bjorklund (bjorklund)
import           Sound.Tidal.Core
import qualified Sound.Tidal.Params as P
import           Sound.Tidal.Pattern
import           Sound.Tidal.Utils

------------------------------------------------------------------------
-- * UI

-- | Randomisation

-- cf. George Marsaglia (2003). "Xorshift RNGs". Journal of Statistical Software 8:14.
-- https://www.jstatsoft.org/article/view/v008i14
xorwise :: Int -> Int
xorwise :: Int -> Int
xorwise Int
x =
  let a :: Int
a = forall a. Bits a => a -> a -> a
xor (forall a. Bits a => a -> Int -> a
shiftL Int
x Int
13) Int
x
      b :: Int
b = forall a. Bits a => a -> a -> a
xor (forall a. Bits a => a -> Int -> a
shiftR Int
a Int
17) Int
a
  in forall a. Bits a => a -> a -> a
xor (forall a. Bits a => a -> Int -> a
shiftL Int
b Int
5) Int
b

-- stretch 300 cycles over the range of [0,2**29 == 536870912) then apply the xorshift algorithm
timeToIntSeed :: RealFrac a => a -> Int
timeToIntSeed :: forall a. RealFrac a => a -> Int
timeToIntSeed = Int -> Int
xorwise forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (RealFrac a, Integral b) => a -> b
truncate forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
* a
536870912) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction :: (RealFrac a => a -> (Int,a))) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Fractional a => a -> a -> a
/ a
300)

intSeedToRand :: Fractional a => Int -> a
intSeedToRand :: forall a. Fractional a => Int -> a
intSeedToRand = (forall a. Fractional a => a -> a -> a
/ a
536870912) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Real a, Fractional b) => a -> b
realToFrac forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Integral a => a -> a -> a
`mod` Int
536870912)

timeToRand :: (RealFrac a, Fractional b) => a -> b
timeToRand :: forall a b. (RealFrac a, Fractional b) => a -> b
timeToRand = forall a. Fractional a => Int -> a
intSeedToRand forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. RealFrac a => a -> Int
timeToIntSeed

timeToRands :: (RealFrac a, Fractional b) => a -> Int -> [b]
timeToRands :: forall a b. (RealFrac a, Fractional b) => a -> Int -> [b]
timeToRands a
t Int
n = forall a. Fractional a => Int -> Int -> [a]
timeToRands' (forall a. RealFrac a => a -> Int
timeToIntSeed a
t) Int
n

timeToRands' :: Fractional a => Int -> Int -> [a]
timeToRands' :: forall a. Fractional a => Int -> Int -> [a]
timeToRands' Int
seed Int
n
  | Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = []
  | Bool
otherwise = (forall a. Fractional a => Int -> a
intSeedToRand Int
seed) forall a. a -> [a] -> [a]
: (forall a. Fractional a => Int -> Int -> [a]
timeToRands' (Int -> Int
xorwise Int
seed) (Int
nforall a. Num a => a -> a -> a
-Int
1))

{-|

`rand` generates a continuous pattern of (pseudo-)random numbers between `0` and `1`.

@
sound "bd*8" # pan rand
@

pans bass drums randomly

@
sound "sn sn ~ sn" # gain rand
@

makes the snares' randomly loud and quiet.

Numbers coming from this pattern are 'seeded' by time. So if you reset
time (via `cps (-1)`, then `cps 1.1` or whatever cps you want to
restart with) the random pattern will emit the exact same _random_
numbers again.

In cases where you need two different random patterns, you can shift
one of them around to change the time from which the _random_ pattern
is read, note the difference:

@
jux (# gain rand) $ sound "sn sn ~ sn" # gain rand
@

and with the juxed version shifted backwards for 1024 cycles:

@
jux (# ((1024 <~) $ gain rand)) $ sound "sn sn ~ sn" # gain rand
@
-}
rand :: Fractional a => Pattern a
rand :: forall a. Fractional a => Pattern a
rand = forall a. (State -> [Event a]) -> Pattern a
Pattern (\(State a :: Arc
a@(Arc Time
s Time
e) ValueMap
_) -> [forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event ([((Int, Int), (Int, Int))] -> Context
Context []) forall a. Maybe a
Nothing Arc
a (forall a b. (Real a, Fractional b) => a -> b
realToFrac forall a b. (a -> b) -> a -> b
$ (forall a b. (RealFrac a, Fractional b) => a -> b
timeToRand ((Time
e forall a. Num a => a -> a -> a
+ Time
s)forall a. Fractional a => a -> a -> a
/Time
2) :: Double))])

-- | Boolean rand - a continuous stream of true/false values, with a 50/50 chance.
brand :: Pattern Bool
brand :: Pattern Bool
brand = Double -> Pattern Bool
_brandBy Double
0.5

-- | Boolean rand with probability as input, e.g. brandBy 0.25 is 25% chance of being true.
brandBy :: Pattern Double -> Pattern Bool
brandBy :: Pattern Double -> Pattern Bool
brandBy Pattern Double
probpat = forall a. Pattern (Pattern a) -> Pattern a
innerJoin forall a b. (a -> b) -> a -> b
$ (\Double
prob -> Double -> Pattern Bool
_brandBy Double
prob) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Double
probpat

_brandBy :: Double -> Pattern Bool
_brandBy :: Double -> Pattern Bool
_brandBy Double
prob = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Ord a => a -> a -> Bool
< Double
prob) forall a. Fractional a => Pattern a
rand

{- | Just like `rand` but for whole numbers, `irand n` generates a pattern of (pseudo-) random whole numbers between `0` to `n-1` inclusive. Notably used to pick a random
samples from a folder:

@
d1 $ segment 4 $ n (irand 5) # sound "drum"
@
-}
irand :: Num a => Pattern Int -> Pattern a
irand :: forall a. Num a => Pattern Int -> Pattern a
irand = (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Num a => Int -> Pattern a
_irand)

_irand :: Num a => Int -> Pattern a
_irand :: forall a. Num a => Int -> Pattern a
_irand Int
i = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (RealFrac a, Integral b) => a -> b
floor :: Double -> Int) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Fractional a => Pattern a
rand

{- | 1D Perlin (smooth) noise, works like rand but smoothly moves between random
values each cycle. `perlinWith` takes a pattern as the RNG's "input" instead
of automatically using the cycle count.
@
d1 $ s "arpy*32" # cutoff (perlinWith (saw * 4) * 2000)
@
will generate a smooth random pattern for the cutoff frequency which will
repeat every cycle (because the saw does)
The `perlin` function uses the cycle count as input and can be used much like @rand@.
-}
perlinWith :: Fractional a => Pattern Double -> Pattern a
perlinWith :: forall a. Fractional a => Pattern Double -> Pattern a
perlinWith Pattern Double
p = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Real a, Fractional b) => a -> b
realToFrac forall a b. (a -> b) -> a -> b
$ (forall {a}. Floating a => a -> a -> a -> a
interp) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Pattern Double
pforall a. Num a => a -> a -> a
-Pattern Double
pa) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b. (RealFrac a, Fractional b) => a -> b
timeToRand forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Double
pa) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b. (RealFrac a, Fractional b) => a -> b
timeToRand forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Double
pb) where
  pa :: Pattern Double
pa = (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Double) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (RealFrac a, Integral b) => a -> b
floor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Double
p
  pb :: Pattern Double
pb = (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Double) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
+Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (RealFrac a, Integral b) => a -> b
floor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Double
p
  interp :: a -> a -> a -> a
interp a
x a
a a
b = a
a forall a. Num a => a -> a -> a
+ forall {a}. Floating a => a -> a
smootherStep a
x forall a. Num a => a -> a -> a
* (a
bforall a. Num a => a -> a -> a
-a
a)
  smootherStep :: a -> a
smootherStep a
x = a
6.0 forall a. Num a => a -> a -> a
* a
xforall a. Floating a => a -> a -> a
**a
5 forall a. Num a => a -> a -> a
- a
15.0 forall a. Num a => a -> a -> a
* a
xforall a. Floating a => a -> a -> a
**a
4 forall a. Num a => a -> a -> a
+ a
10.0 forall a. Num a => a -> a -> a
* a
xforall a. Floating a => a -> a -> a
**a
3

perlin :: Fractional a => Pattern a
perlin :: forall a. Fractional a => Pattern a
perlin = forall a. Fractional a => Pattern Double -> Pattern a
perlinWith (forall a. (Time -> a) -> Pattern a
sig forall a. Fractional a => Time -> a
fromRational)

{- `perlin2With` is Perlin noise with a 2-dimensional input. This can be
useful for more control over how the randomness repeats (or doesn't).
@
d1
 $ s "[supersaw:-12*32]"
 # lpf (rangex 60 5000 $ perlin2With (cosine*2) (sine*2))
 # lpq 0.3
@
will generate a smooth random cutoff pattern that repeats every cycle without
any reversals or discontinuities (because the 2D path is a circle).
`perlin2` only needs one input because it uses the cycle count as the
second input.
-}
perlin2With :: Pattern Double -> Pattern Double -> Pattern Double
perlin2With :: Pattern Double -> Pattern Double -> Pattern Double
perlin2With Pattern Double
x Pattern Double
y = (forall a. Fractional a => a -> a -> a
/Pattern Double
2) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
+Pattern Double
1) forall a b. (a -> b) -> a -> b
$ forall {a}. Floating a => a -> a -> a -> a -> a -> a -> a
interp2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Double
xfrac forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pattern Double
yfrac forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pattern Double
dota forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pattern Double
dotb forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pattern Double
dotc forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pattern Double
dotd where
  fl :: Pattern Double -> Pattern Double
fl = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Double) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (RealFrac a, Integral b) => a -> b
floor)
  ce :: Pattern Double -> Pattern Double
ce = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Double) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
+Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (RealFrac a, Integral b) => a -> b
floor)
  xfrac :: Pattern Double
xfrac = Pattern Double
x forall a. Num a => a -> a -> a
- Pattern Double -> Pattern Double
fl Pattern Double
x
  yfrac :: Pattern Double
yfrac = Pattern Double
y forall a. Num a => a -> a -> a
- Pattern Double -> Pattern Double
fl Pattern Double
y
  randAngle :: a -> a -> a
randAngle a
a a
b = a
2 forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi forall a. Num a => a -> a -> a
* forall a b. (RealFrac a, Fractional b) => a -> b
timeToRand (a
a forall a. Num a => a -> a -> a
+ a
0.0001 forall a. Num a => a -> a -> a
* a
b)
  pcos :: f a -> f a -> f b
pcos f a
x' f a
y' = forall {a}. Floating a => a -> a
cos forall a b. (a -> b) -> a -> b
$ forall {a} {a}. (Floating a, RealFrac a) => a -> a -> a
randAngle forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
x' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
y'
  psin :: f a -> f a -> f b
psin f a
x' f a
y' = forall {a}. Floating a => a -> a
sin forall a b. (a -> b) -> a -> b
$ forall {a} {a}. (Floating a, RealFrac a) => a -> a -> a
randAngle forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
x' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
y'
  dota :: Pattern Double
dota = forall {f :: * -> *} {b} {a}.
(Applicative f, Floating b, Floating (f b), RealFrac a) =>
f a -> f a -> f b
pcos (Pattern Double -> Pattern Double
fl Pattern Double
x) (Pattern Double -> Pattern Double
fl Pattern Double
y) forall a. Num a => a -> a -> a
* Pattern Double
xfrac       forall a. Num a => a -> a -> a
+ forall {f :: * -> *} {b} {a}.
(Applicative f, Floating b, Floating (f b), RealFrac a) =>
f a -> f a -> f b
psin (Pattern Double -> Pattern Double
fl Pattern Double
x) (Pattern Double -> Pattern Double
fl Pattern Double
y) forall a. Num a => a -> a -> a
* Pattern Double
yfrac
  dotb :: Pattern Double
dotb = forall {f :: * -> *} {b} {a}.
(Applicative f, Floating b, Floating (f b), RealFrac a) =>
f a -> f a -> f b
pcos (Pattern Double -> Pattern Double
ce Pattern Double
x) (Pattern Double -> Pattern Double
fl Pattern Double
y) forall a. Num a => a -> a -> a
* (Pattern Double
xfrac forall a. Num a => a -> a -> a
- Pattern Double
1) forall a. Num a => a -> a -> a
+ forall {f :: * -> *} {b} {a}.
(Applicative f, Floating b, Floating (f b), RealFrac a) =>
f a -> f a -> f b
psin (Pattern Double -> Pattern Double
ce Pattern Double
x) (Pattern Double -> Pattern Double
fl Pattern Double
y) forall a. Num a => a -> a -> a
* Pattern Double
yfrac
  dotc :: Pattern Double
dotc = forall {f :: * -> *} {b} {a}.
(Applicative f, Floating b, Floating (f b), RealFrac a) =>
f a -> f a -> f b
pcos (Pattern Double -> Pattern Double
fl Pattern Double
x) (Pattern Double -> Pattern Double
ce Pattern Double
y) forall a. Num a => a -> a -> a
* Pattern Double
xfrac       forall a. Num a => a -> a -> a
+ forall {f :: * -> *} {b} {a}.
(Applicative f, Floating b, Floating (f b), RealFrac a) =>
f a -> f a -> f b
psin (Pattern Double -> Pattern Double
fl Pattern Double
x) (Pattern Double -> Pattern Double
ce Pattern Double
y) forall a. Num a => a -> a -> a
* (Pattern Double
yfrac forall a. Num a => a -> a -> a
- Pattern Double
1)
  dotd :: Pattern Double
dotd = forall {f :: * -> *} {b} {a}.
(Applicative f, Floating b, Floating (f b), RealFrac a) =>
f a -> f a -> f b
pcos (Pattern Double -> Pattern Double
ce Pattern Double
x) (Pattern Double -> Pattern Double
ce Pattern Double
y) forall a. Num a => a -> a -> a
* (Pattern Double
xfrac forall a. Num a => a -> a -> a
- Pattern Double
1) forall a. Num a => a -> a -> a
+ forall {f :: * -> *} {b} {a}.
(Applicative f, Floating b, Floating (f b), RealFrac a) =>
f a -> f a -> f b
psin (Pattern Double -> Pattern Double
ce Pattern Double
x) (Pattern Double -> Pattern Double
ce Pattern Double
y) forall a. Num a => a -> a -> a
* (Pattern Double
yfrac forall a. Num a => a -> a -> a
- Pattern Double
1)
  interp2 :: a -> a -> a -> a -> a -> a -> a
interp2 a
x' a
y' a
a a
b a
c a
d = (a
1.0 forall a. Num a => a -> a -> a
- forall {a}. Floating a => a -> a
s a
x') forall a. Num a => a -> a -> a
* (a
1.0 forall a. Num a => a -> a -> a
- forall {a}. Floating a => a -> a
s a
y') forall a. Num a => a -> a -> a
* a
a  forall a. Num a => a -> a -> a
+  forall {a}. Floating a => a -> a
s a
x' forall a. Num a => a -> a -> a
* (a
1.0 forall a. Num a => a -> a -> a
- forall {a}. Floating a => a -> a
s a
y') forall a. Num a => a -> a -> a
* a
b
                          forall a. Num a => a -> a -> a
+ (a
1.0 forall a. Num a => a -> a -> a
- forall {a}. Floating a => a -> a
s a
x') forall a. Num a => a -> a -> a
* forall {a}. Floating a => a -> a
s a
y' forall a. Num a => a -> a -> a
* a
c  forall a. Num a => a -> a -> a
+  forall {a}. Floating a => a -> a
s a
x' forall a. Num a => a -> a -> a
* forall {a}. Floating a => a -> a
s a
y' forall a. Num a => a -> a -> a
* a
d
  s :: a -> a
s a
x' = a
6.0 forall a. Num a => a -> a -> a
* a
x'forall a. Floating a => a -> a -> a
**a
5 forall a. Num a => a -> a -> a
- a
15.0 forall a. Num a => a -> a -> a
* a
x'forall a. Floating a => a -> a -> a
**a
4 forall a. Num a => a -> a -> a
+ a
10.0 forall a. Num a => a -> a -> a
* a
x'forall a. Floating a => a -> a -> a
**a
3

perlin2 :: Pattern Double -> Pattern Double
perlin2 :: Pattern Double -> Pattern Double
perlin2 = Pattern Double -> Pattern Double -> Pattern Double
perlin2With (forall a. (Time -> a) -> Pattern a
sig forall a. Fractional a => Time -> a
fromRational)

{- | Randomly picks an element from the given list

@
sound "superpiano(3,8)" # note (choose ["a", "e", "g", "c"])
@

plays a melody randomly choosing one of the four notes \"a\", \"e\", \"g\", \"c\".
-}
choose :: [a] -> Pattern a
choose :: forall a. [a] -> Pattern a
choose = forall a. Pattern Double -> [a] -> Pattern a
chooseBy forall a. Fractional a => Pattern a
rand

chooseBy :: Pattern Double -> [a] -> Pattern a
chooseBy :: forall a. Pattern Double -> [a] -> Pattern a
chooseBy Pattern Double
_ [] = forall a. Pattern a
silence
chooseBy Pattern Double
f [a]
xs = ([a]
xs forall a. [a] -> Int -> a
!!!) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (RealFrac a, Integral b) => a -> b
floor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Num a => Pattern a -> Pattern a -> Pattern a -> Pattern a
range Pattern Double
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs) Pattern Double
f

{- | Like @choose@, but works on an a list of tuples of values and weights

@
sound "superpiano(3,8)" # note (wchoose [("a",1), ("e",0.5), ("g",2), ("c",1)])
@

In the above example, the "a" and "c" notes are twice as likely to
play as the "e" note, and half as likely to play as the "g" note.

-}
wchoose :: [(a,Double)] -> Pattern a
wchoose :: forall a. [(a, Double)] -> Pattern a
wchoose = forall a. Pattern Double -> [(a, Double)] -> Pattern a
wchooseBy forall a. Fractional a => Pattern a
rand

wchooseBy :: Pattern Double -> [(a,Double)] -> Pattern a
wchooseBy :: forall a. Pattern Double -> [(a, Double)] -> Pattern a
wchooseBy Pattern Double
pat [(a, Double)]
pairs = Double -> a
match forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Double
pat
  where
    match :: Double -> a
match Double
r = [a]
values forall a. [a] -> Int -> a
!! forall a. [a] -> a
head (forall a. (a -> Bool) -> [a] -> [Int]
findIndices (forall a. Ord a => a -> a -> Bool
> (Double
rforall a. Num a => a -> a -> a
*Double
total)) [Double]
cweights)
    cweights :: [Double]
cweights = forall a. (a -> a -> a) -> [a] -> [a]
scanl1 forall a. Num a => a -> a -> a
(+) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(a, Double)]
pairs)
    values :: [a]
values = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(a, Double)]
pairs
    total :: Double
total = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(a, Double)]
pairs

{- |
Similar to `degrade` `degradeBy` allows you to control the percentage of events that
are removed. For example, to remove events 90% of the time:

@
d1 $ slow 2 $ degradeBy 0.9 $ sound "[[[feel:5*8,feel*3] feel:3*8], feel*4]"
   # accelerate "-6"
   # speed "2"
@

-}
degradeBy :: Pattern Double -> Pattern a -> Pattern a
degradeBy :: forall a. Pattern Double -> Pattern a -> Pattern a
degradeBy = forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam forall a. Double -> Pattern a -> Pattern a
_degradeBy

_degradeBy :: Double -> Pattern a -> Pattern a
_degradeBy :: forall a. Double -> Pattern a -> Pattern a
_degradeBy = forall a. Pattern Double -> Double -> Pattern a -> Pattern a
_degradeByUsing forall a. Fractional a => Pattern a
rand

-- Useful for manipulating random stream, e.g. to change 'seed'
_degradeByUsing :: Pattern Double -> Double -> Pattern a -> Pattern a
_degradeByUsing :: forall a. Pattern Double -> Double -> Pattern a -> Pattern a
_degradeByUsing Pattern Double
prand Double
x Pattern a
p = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Pattern a -> Pattern a
filterValues ((forall a. Ord a => a -> a -> Bool
> Double
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
p forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
<* Pattern Double
prand

unDegradeBy :: Pattern Double -> Pattern a -> Pattern a
unDegradeBy :: forall a. Pattern Double -> Pattern a -> Pattern a
unDegradeBy = forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam forall a. Double -> Pattern a -> Pattern a
_unDegradeBy

_unDegradeBy :: Double -> Pattern a -> Pattern a
_unDegradeBy :: forall a. Double -> Pattern a -> Pattern a
_unDegradeBy Double
x Pattern a
p = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Pattern a -> Pattern a
filterValues ((forall a. Ord a => a -> a -> Bool
<= Double
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
p forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
<* forall a. Fractional a => Pattern a
rand

degradeOverBy :: Int -> Pattern Double -> Pattern a -> Pattern a
degradeOverBy :: forall a. Int -> Pattern Double -> Pattern a -> Pattern a
degradeOverBy Int
i Pattern Double
tx Pattern a
p = forall a. Pattern (Pattern a) -> Pattern a
unwrap forall a b. (a -> b) -> a -> b
$ (\Double
x -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Pattern a -> Pattern a
filterValues ((forall a. Ord a => a -> a -> Bool
> Double
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
p forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
<* forall a. Int -> Pattern a -> Pattern a
fastRepeatCycles Int
i forall a. Fractional a => Pattern a
rand) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Pattern Time -> Pattern a -> Pattern a
slow (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i) Pattern Double
tx


{- | Use @sometimesBy@ to apply a given function "sometimes". For example, the
following code results in `density 2` being applied about 25% of the time:

@
d1 $ sometimesBy 0.25 (density 2) $ sound "bd*8"
@

There are some aliases as well:

@
sometimes = sometimesBy 0.5
often = sometimesBy 0.75
rarely = sometimesBy 0.25
almostNever = sometimesBy 0.1
almostAlways = sometimesBy 0.9
@
-}
sometimesBy :: Pattern Double -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
sometimesBy :: forall a.
Pattern Double
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
sometimesBy Pattern Double
x Pattern a -> Pattern a
f Pattern a
pat = forall a. Pattern a -> Pattern a -> Pattern a
overlay (forall a. Pattern Double -> Pattern a -> Pattern a
degradeBy Pattern Double
x Pattern a
pat) (Pattern a -> Pattern a
f forall a b. (a -> b) -> a -> b
$ forall a. Pattern Double -> Pattern a -> Pattern a
unDegradeBy Pattern Double
x Pattern a
pat)

sometimesBy' :: Pattern Double -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
sometimesBy' :: forall a.
Pattern Double
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
sometimesBy' Pattern Double
x Pattern a -> Pattern a
f Pattern a
pat = forall a. Pattern a -> Pattern a -> Pattern a
overlay (forall a. Pattern Double -> Pattern a -> Pattern a
degradeBy Pattern Double
x Pattern a
pat) (forall a. Pattern Double -> Pattern a -> Pattern a
unDegradeBy Pattern Double
x forall a b. (a -> b) -> a -> b
$ Pattern a -> Pattern a
f Pattern a
pat)

-- | @sometimes@ is an alias for sometimesBy 0.5.
sometimes :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
sometimes :: forall a. (Pattern a -> Pattern a) -> Pattern a -> Pattern a
sometimes = forall a.
Pattern Double
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
sometimesBy Pattern Double
0.5

sometimes' :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
sometimes' :: forall a. (Pattern a -> Pattern a) -> Pattern a -> Pattern a
sometimes' = forall a.
Pattern Double
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
sometimesBy' Pattern Double
0.5

-- | @often@ is an alias for sometimesBy 0.75.
often :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
often :: forall a. (Pattern a -> Pattern a) -> Pattern a -> Pattern a
often = forall a.
Pattern Double
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
sometimesBy Pattern Double
0.75

often' :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
often' :: forall a. (Pattern a -> Pattern a) -> Pattern a -> Pattern a
often' = forall a.
Pattern Double
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
sometimesBy' Pattern Double
0.75

-- | @rarely@ is an alias for sometimesBy 0.25.
rarely :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
rarely :: forall a. (Pattern a -> Pattern a) -> Pattern a -> Pattern a
rarely = forall a.
Pattern Double
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
sometimesBy Pattern Double
0.25

rarely' :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
rarely' :: forall a. (Pattern a -> Pattern a) -> Pattern a -> Pattern a
rarely' = forall a.
Pattern Double
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
sometimesBy' Pattern Double
0.25

-- | @almostNever@ is an alias for sometimesBy 0.1
almostNever :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
almostNever :: forall a. (Pattern a -> Pattern a) -> Pattern a -> Pattern a
almostNever = forall a.
Pattern Double
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
sometimesBy Pattern Double
0.1

almostNever' :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
almostNever' :: forall a. (Pattern a -> Pattern a) -> Pattern a -> Pattern a
almostNever' = forall a.
Pattern Double
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
sometimesBy Pattern Double
0.1

-- | @almostAlways@ is an alias for sometimesBy 0.9
almostAlways :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
almostAlways :: forall a. (Pattern a -> Pattern a) -> Pattern a -> Pattern a
almostAlways = forall a.
Pattern Double
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
sometimesBy Pattern Double
0.9

almostAlways' :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
almostAlways' :: forall a. (Pattern a -> Pattern a) -> Pattern a -> Pattern a
almostAlways' = forall a.
Pattern Double
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
sometimesBy' Pattern Double
0.9

never :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
never :: forall a. (Pattern a -> Pattern a) -> Pattern a -> Pattern a
never = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. a -> b -> a
const

always :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
always :: forall a. (Pattern a -> Pattern a) -> Pattern a -> Pattern a
always = forall a. a -> a
id

{- | @someCyclesBy@ is a cycle-by-cycle version of @sometimesBy@. It has a
`someCycles = someCyclesBy 0.5` alias -}
someCyclesBy :: Pattern Double -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
someCyclesBy :: forall a.
Pattern Double
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
someCyclesBy Pattern Double
pd Pattern a -> Pattern a
f Pattern a
pat = forall a. Pattern (Pattern a) -> Pattern a
innerJoin forall a b. (a -> b) -> a -> b
$ (\Double
d -> forall a.
Double -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_someCyclesBy Double
d Pattern a -> Pattern a
f Pattern a
pat) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Double
pd

_someCyclesBy :: Double -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_someCyclesBy :: forall a.
Double -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_someCyclesBy Double
x = forall a.
(Int -> Bool) -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
when forall {a}. Integral a => a -> Bool
test
  where test :: a -> Bool
test a
c = forall a b. (RealFrac a, Fractional b) => a -> b
timeToRand (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
c :: Double) forall a. Ord a => a -> a -> Bool
< Double
x

somecyclesBy :: Pattern Double -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
somecyclesBy :: forall a.
Pattern Double
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
somecyclesBy = forall a.
Pattern Double
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
someCyclesBy

someCycles :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
someCycles :: forall a. (Pattern a -> Pattern a) -> Pattern a -> Pattern a
someCycles = forall a.
Pattern Double
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
someCyclesBy Pattern Double
0.5

somecycles :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
somecycles :: forall a. (Pattern a -> Pattern a) -> Pattern a -> Pattern a
somecycles = forall a. (Pattern a -> Pattern a) -> Pattern a -> Pattern a
someCycles

{- | `degrade` randomly removes events from a pattern 50% of the time:

@
d1 $ slow 2 $ degrade $ sound "[[[feel:5*8,feel*3] feel:3*8], feel*4]"
   # accelerate "-6"
   # speed "2"
@

The shorthand syntax for `degrade` is a question mark: `?`. Using `?`
will allow you to randomly remove events from a portion of a pattern:

@
d1 $ slow 2 $ sound "bd ~ sn bd ~ bd? [sn bd?] ~"
@

You can also use `?` to randomly remove events from entire sub-patterns:

@
d1 $ slow 2 $ sound "[[[feel:5*8,feel*3] feel:3*8]?, feel*4]"
@
-}
degrade :: Pattern a -> Pattern a
degrade :: forall a. Pattern a -> Pattern a
degrade = forall a. Double -> Pattern a -> Pattern a
_degradeBy Double
0.5

{- | (The above means that `brak` is a function from patterns of any type,
to a pattern of the same type.)

Make a pattern sound a bit like a breakbeat

Example:

@
d1 $ sound (brak "bd sn kurt")
@
-}
brak :: Pattern a -> Pattern a
brak :: forall a. Pattern a -> Pattern a
brak = forall a.
(Int -> Bool) -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
when ((forall a. Eq a => a -> a -> Bool
== Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Integral a => a -> a -> a
`mod` Int
2)) (((Integer
1forall a. Integral a => a -> a -> Ratio a
%Integer
4) forall a. Time -> Pattern a -> Pattern a
`rotR`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Pattern a
x -> forall a. [Pattern a] -> Pattern a
fastcat [Pattern a
x, forall a. Pattern a
silence]))

{- | Divides a pattern into a given number of subdivisions, plays the subdivisions
in order, but increments the starting subdivision each cycle. The pattern
wraps to the first subdivision after the last subdivision is played.

Example:

@
d1 $ iter 4 $ sound "bd hh sn cp"
@

This will produce the following over four cycles:

@
bd hh sn cp
hh sn cp bd
sn cp bd hh
cp bd hh sn
@

There is also `iter'`, which shifts the pattern in the opposite direction.

-}
iter :: Pattern Int -> Pattern c -> Pattern c
iter :: forall c. Pattern Int -> Pattern c -> Pattern c
iter = forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam forall a. Int -> Pattern a -> Pattern a
_iter

_iter :: Int -> Pattern a -> Pattern a
_iter :: forall a. Int -> Pattern a -> Pattern a
_iter Int
n Pattern a
p = forall a. [Pattern a] -> Pattern a
slowcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i forall a. Integral a => a -> a -> Ratio a
% forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) forall a. Time -> Pattern a -> Pattern a
`rotL` Pattern a
p) [Int
0 .. (Int
nforall a. Num a => a -> a -> a
-Int
1)]

-- | @iter'@ is the same as @iter@, but decrements the starting
-- subdivision instead of incrementing it.
iter' :: Pattern Int -> Pattern c -> Pattern c
iter' :: forall c. Pattern Int -> Pattern c -> Pattern c
iter' = forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam forall a. Int -> Pattern a -> Pattern a
_iter'

_iter' :: Int -> Pattern a -> Pattern a
_iter' :: forall a. Int -> Pattern a -> Pattern a
_iter' Int
n Pattern a
p = forall a. [Pattern a] -> Pattern a
slowcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i forall a. Integral a => a -> a -> Ratio a
% forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) forall a. Time -> Pattern a -> Pattern a
`rotR` Pattern a
p) [Int
0 .. (Int
nforall a. Num a => a -> a -> a
-Int
1)]

-- | @palindrome p@ applies @rev@ to @p@ every other cycle, so that
-- the pattern alternates between forwards and backwards.
palindrome :: Pattern a -> Pattern a
palindrome :: forall a. Pattern a -> Pattern a
palindrome Pattern a
p = forall a. Pattern a -> Pattern a -> Pattern a
slowAppend Pattern a
p (forall a. Pattern a -> Pattern a
rev Pattern a
p)

-- | Composing patterns

{- | The function @seqP@ allows you to define when
a sound within a list starts and ends. The code below contains three
separate patterns in a `stack`, but each has different start times
(zero cycles, eight cycles, and sixteen cycles, respectively). All
patterns stop after 128 cycles:

@
d1 $ seqP [
  (0, 128, sound "bd bd*2"),
  (8, 128, sound "hh*2 [sn cp] cp future*4"),
  (16, 128, sound (samples "arpy*8" (run 16)))
]
@
-}
seqP :: [(Time, Time, Pattern a)] -> Pattern a
seqP :: forall a. [(Time, Time, Pattern a)] -> Pattern a
seqP [(Time, Time, Pattern a)]
ps = forall a. [Pattern a] -> Pattern a
stack forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(Time
s, Time
e, Pattern a
p) -> forall a. Time -> Time -> Pattern a -> Pattern a
playFor Time
s Time
e (Time -> Time
sam Time
s forall a. Time -> Pattern a -> Pattern a
`rotR` Pattern a
p)) [(Time, Time, Pattern a)]
ps

-- | Degrades a pattern over the given time.
fadeOut :: Time -> Pattern a -> Pattern a
fadeOut :: forall a. Time -> Pattern a -> Pattern a
fadeOut Time
dur Pattern a
p = forall a. Pattern (Pattern a) -> Pattern a
innerJoin forall a b. (a -> b) -> a -> b
$ (forall a. Double -> Pattern a -> Pattern a
`_degradeBy` Pattern a
p) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Time -> Pattern a -> Pattern a
_slow Time
dur Pattern Double
envL

-- | Alternate version to @fadeOut@ where you can provide the time from which the fade starts
fadeOutFrom :: Time -> Time -> Pattern a -> Pattern a
fadeOutFrom :: forall a. Time -> Time -> Pattern a -> Pattern a
fadeOutFrom Time
from Time
dur Pattern a
p = forall a. Pattern (Pattern a) -> Pattern a
innerJoin forall a b. (a -> b) -> a -> b
$ (forall a. Double -> Pattern a -> Pattern a
`_degradeBy` Pattern a
p) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Time
from forall a. Time -> Pattern a -> Pattern a
`rotR` forall a. Time -> Pattern a -> Pattern a
_slow Time
dur Pattern Double
envL)

-- | 'Undegrades' a pattern over the given time.
fadeIn :: Time -> Pattern a -> Pattern a
fadeIn :: forall a. Time -> Pattern a -> Pattern a
fadeIn Time
dur Pattern a
p = forall a. Pattern (Pattern a) -> Pattern a
innerJoin forall a b. (a -> b) -> a -> b
$ (forall a. Double -> Pattern a -> Pattern a
`_degradeBy` Pattern a
p) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Time -> Pattern a -> Pattern a
_slow Time
dur Pattern Double
envLR

-- | Alternate version to @fadeIn@ where you can provide the time from
-- which the fade in starts
fadeInFrom :: Time -> Time -> Pattern a -> Pattern a
fadeInFrom :: forall a. Time -> Time -> Pattern a -> Pattern a
fadeInFrom Time
from Time
dur Pattern a
p = forall a. Pattern (Pattern a) -> Pattern a
innerJoin forall a b. (a -> b) -> a -> b
$ (forall a. Double -> Pattern a -> Pattern a
`_degradeBy` Pattern a
p) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Time
from forall a. Time -> Pattern a -> Pattern a
`rotR` forall a. Time -> Pattern a -> Pattern a
_slow Time
dur Pattern Double
envLR)

{- | The 'spread' function allows you to take a pattern transformation
which takes a parameter, such as `slow`, and provide several
parameters which are switched between. In other words it 'spreads' a
function across several values.

Taking a simple high hat loop as an example:

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

We can slow it down by different amounts, such as by a half:

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

Or by four thirds (i.e. speeding it up by a third; `4%3` means four over
three):

@
d1 $ slow (4%3) $ sound "ho ho:2 ho:3 hc"
@

But if we use `spread`, we can make a pattern which alternates between
the two speeds:

@
d1 $ spread slow [2,4%3] $ sound "ho ho:2 ho:3 hc"
@

Note that if you pass ($) as the function to spread values over, you
can put functions as the list of values. For example:

@
d1 $ spread ($) [density 2, rev, slow 2, striate 3, (# speed "0.8")]
    $ sound "[bd*2 [~ bd]] [sn future]*2 cp jvbass*4"
@

Above, the pattern will have these transforms applied to it, one at a time, per cycle:

* cycle 1: `density 2` - pattern will increase in speed
* cycle 2: `rev` - pattern will be reversed
* cycle 3: `slow 2` - pattern will decrease in speed
* cycle 4: `striate 3` - pattern will be granualized
* cycle 5: `(# speed "0.8")` - pattern samples will be played back more slowly

After `(# speed "0.8")`, the transforms will repeat and start at `density 2` again.
-}
spread :: (a -> t -> Pattern b) -> [a] -> t -> Pattern b
spread :: forall a t b. (a -> t -> Pattern b) -> [a] -> t -> Pattern b
spread a -> t -> Pattern b
f [a]
xs t
p = forall a. [Pattern a] -> Pattern a
slowcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (a -> t -> Pattern b
`f` t
p) [a]
xs

slowspread :: (a -> t -> Pattern b) -> [a] -> t -> Pattern b
slowspread :: forall a t b. (a -> t -> Pattern b) -> [a] -> t -> Pattern b
slowspread = forall a t b. (a -> t -> Pattern b) -> [a] -> t -> Pattern b
spread

{- | @fastspread@ works the same as @spread@, but the result is squashed into a single cycle. If you gave four values to @spread@, then the result would seem to speed up by a factor of four. Compare these two:

d1 $ spread chop [4,64,32,16] $ sound "ho ho:2 ho:3 hc"

d1 $ fastspread chop [4,64,32,16] $ sound "ho ho:2 ho:3 hc"

There is also @slowspread@, which is an alias of @spread@.
-}
fastspread :: (a -> t -> Pattern b) -> [a] -> t -> Pattern b
fastspread :: forall a t b. (a -> t -> Pattern b) -> [a] -> t -> Pattern b
fastspread a -> t -> Pattern b
f [a]
xs t
p = forall a. [Pattern a] -> Pattern a
fastcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (a -> t -> Pattern b
`f` t
p) [a]
xs

{- | There's a version of this function, `spread'` (pronounced "spread prime"), which takes a *pattern* of parameters, instead of a list:

@
d1 $ spread' slow "2 4%3" $ sound "ho ho:2 ho:3 hc"
@

This is quite a messy area of Tidal - due to a slight difference of
implementation this sounds completely different! One advantage of
using `spread'` though is that you can provide polyphonic parameters, e.g.:

@
d1 $ spread' slow "[2 4%3, 3]" $ sound "ho ho:2 ho:3 hc"
@
-}
spread' :: Monad m => (a -> b -> m c) -> m a -> b -> m c
spread' :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> m c) -> m a -> b -> m c
spread' a -> b -> m c
f m a
vpat b
pat = m a
vpat forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
v -> a -> b -> m c
f a
v b
pat

{- | `spreadChoose f xs p` is similar to `slowspread` but picks values from
`xs` at random, rather than cycling through them in order. It has a
shorter alias `spreadr`.
-}
spreadChoose :: (t -> t1 -> Pattern b) -> [t] -> t1 -> Pattern b
spreadChoose :: forall a t b. (a -> t -> Pattern b) -> [a] -> t -> Pattern b
spreadChoose t -> t1 -> Pattern b
f [t]
vs t1
p = do t
v <- forall a. Time -> Pattern a -> Pattern a
_segment Time
1 (forall a. [a] -> Pattern a
choose [t]
vs)
                         t -> t1 -> Pattern b
f t
v t1
p

spreadr :: (t -> t1 -> Pattern b) -> [t] -> t1 -> Pattern b
spreadr :: forall a t b. (a -> t -> Pattern b) -> [a] -> t -> Pattern b
spreadr = forall a t b. (a -> t -> Pattern b) -> [a] -> t -> Pattern b
spreadChoose

{-| Decide whether to apply one or another function depending on the result of a test function that is passed the current cycle as a number.

@
d1 $ ifp ((== 0).(flip mod 2))
  (striate 4)
  (# coarse "24 48") $
  sound "hh hc"
@

This will apply `striate 4` for every _even_ cycle and aply `# coarse "24 48"` for every _odd_.

Detail: As you can see the test function is arbitrary and does not rely on anything tidal specific. In fact it uses only plain haskell functionality, that is: it calculates the modulo of 2 of the current cycle which is either 0 (for even cycles) or 1. It then compares this value against 0 and returns the result, which is either `True` or `False`. This is what the `ifp` signature's first part signifies `(Int -> Bool)`, a function that takes a whole number and returns either `True` or `False`.
-}
ifp :: (Int -> Bool) -> (Pattern a -> Pattern a) -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
ifp :: forall a.
(Int -> Bool)
-> (Pattern a -> Pattern a)
-> (Pattern a -> Pattern a)
-> Pattern a
-> Pattern a
ifp Int -> Bool
test Pattern a -> Pattern a
f1 Pattern a -> Pattern a
f2 Pattern a
p = forall a. Pattern a -> Pattern a
splitQueries forall a b. (a -> b) -> a -> b
$ Pattern a
p {query :: State -> [Event a]
query = State -> [Event a]
q}
  where q :: State -> [Event a]
q State
a | Int -> Bool
test (forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ forall a. ArcF a -> a
start forall a b. (a -> b) -> a -> b
$ State -> Arc
arc State
a) = forall a. Pattern a -> State -> [Event a]
query (Pattern a -> Pattern a
f1 Pattern a
p) State
a
            | Bool
otherwise = forall a. Pattern a -> State -> [Event a]
query (Pattern a -> Pattern a
f2 Pattern a
p) State
a

-- | @wedge t p p'@ combines patterns @p@ and @p'@ by squashing the
-- @p@ into the portion of each cycle given by @t@, and @p'@ into the
-- remainer of each cycle.
wedge :: Pattern Time -> Pattern a -> Pattern a -> Pattern a
wedge :: forall a. Pattern Time -> Pattern a -> Pattern a -> Pattern a
wedge Pattern Time
pt Pattern a
pa Pattern a
pb = forall a. Pattern (Pattern a) -> Pattern a
innerJoin forall a b. (a -> b) -> a -> b
$ (\Time
t -> forall a. Time -> Pattern a -> Pattern a -> Pattern a
_wedge Time
t Pattern a
pa Pattern a
pb) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Time
pt

_wedge :: Time -> Pattern a -> Pattern a -> Pattern a
_wedge :: forall a. Time -> Pattern a -> Pattern a -> Pattern a
_wedge Time
0 Pattern a
_ Pattern a
p' = Pattern a
p'
_wedge Time
1 Pattern a
p Pattern a
_ = Pattern a
p
_wedge Time
t Pattern a
p Pattern a
p' = forall a. Pattern a -> Pattern a -> Pattern a
overlay (forall a. Time -> Pattern a -> Pattern a
_fastGap (Time
1forall a. Fractional a => a -> a -> a
/Time
t) Pattern a
p) (Time
t forall a. Time -> Pattern a -> Pattern a
`rotR` forall a. Time -> Pattern a -> Pattern a
_fastGap (Time
1forall a. Fractional a => a -> a -> a
/(Time
1forall a. Num a => a -> a -> a
-Time
t)) Pattern a
p')


{- | @whenmod@ has a similar form and behavior to `every`, but requires an
additional number. Applies the function to the pattern, when the
remainder of the current loop number divided by the first parameter,
is greater or equal than the second parameter.

For example the following makes every other block of four loops twice
as dense:

@
d1 $ whenmod 8 4 (density 2) (sound "bd sn kurt")
@
-}
whenmod :: Pattern Time -> Pattern Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
whenmod :: forall a.
Pattern Time
-> Pattern Time
-> (Pattern a -> Pattern a)
-> Pattern a
-> Pattern a
whenmod Pattern Time
a Pattern Time
b Pattern a -> Pattern a
f Pattern a
pat = forall a. Pattern (Pattern a) -> Pattern a
innerJoin forall a b. (a -> b) -> a -> b
$ (\Time
a' Time
b' -> forall a.
Time -> Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_whenmod Time
a' Time
b' Pattern a -> Pattern a
f Pattern a
pat) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Time
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pattern Time
b

_whenmod :: Time -> Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_whenmod :: forall a.
Time -> Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_whenmod Time
a Time
b = forall a.
(Time -> Bool)
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
whenT (\Time
t -> ((Time
t forall a. Real a => a -> a -> a
`mod'` Time
a) forall a. Ord a => a -> a -> Bool
>= Time
b ))


{- |
@
superimpose f p = stack [p, f p]
@

`superimpose` plays a modified version of a pattern at the same time as the original pattern,
resulting in two patterns being played at the same time.

@
d1 $ superimpose (density 2) $ sound "bd sn [cp ht] hh"
d1 $ superimpose ((# speed "2") . (0.125 <~)) $ sound "bd sn cp hh"
@

-}
superimpose :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
superimpose :: forall a. (Pattern a -> Pattern a) -> Pattern a -> Pattern a
superimpose Pattern a -> Pattern a
f Pattern a
p = forall a. [Pattern a] -> Pattern a
stack [Pattern a
p, Pattern a -> Pattern a
f Pattern a
p]

{- | @trunc@ truncates a pattern so that only a fraction of the pattern is played.
The following example plays only the first quarter of the pattern:

@
d1 $ trunc 0.25 $ sound "bd sn*2 cp hh*4 arpy bd*2 cp bd*2"
@
-}
trunc :: Pattern Time -> Pattern a -> Pattern a
trunc :: forall a. Pattern Time -> Pattern a -> Pattern a
trunc = forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam forall a. Time -> Pattern a -> Pattern a
_trunc

_trunc :: Time -> Pattern a -> Pattern a
_trunc :: forall a. Time -> Pattern a -> Pattern a
_trunc Time
t = forall a. (Time, Time) -> Pattern a -> Pattern a
compress (Time
0, Time
t) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Arc -> Pattern a -> Pattern a
zoomArc (forall a. a -> a -> ArcF a
Arc Time
0 Time
t)

{- | @linger@ is similar to `trunc` but the truncated part of the pattern loops until the end of the cycle.

@
d1 $ linger 0.25 $ sound "bd sn*2 cp hh*4 arpy bd*2 cp bd*2"
@

If you give it a negative number, it will linger on the last part of
the pattern, instead of the start of it. E.g. to linger on the last
quarter:

@
d1 $ linger (-0.25) $ sound "bd sn*2 cp hh*4 arpy bd*2 cp bd*2"
@
-}
linger :: Pattern Time -> Pattern a -> Pattern a
linger :: forall a. Pattern Time -> Pattern a -> Pattern a
linger = forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam forall a. Time -> Pattern a -> Pattern a
_linger

_linger :: Time -> Pattern a -> Pattern a
_linger :: forall a. Time -> Pattern a -> Pattern a
_linger Time
n Pattern a
p | Time
n forall a. Ord a => a -> a -> Bool
< Time
0 = forall a. Time -> Pattern a -> Pattern a
_fast (Time
1forall a. Fractional a => a -> a -> a
/Time
n) forall a b. (a -> b) -> a -> b
$ forall a. Arc -> Pattern a -> Pattern a
zoomArc (forall a. a -> a -> ArcF a
Arc (Time
1 forall a. Num a => a -> a -> a
+ Time
n) Time
1) Pattern a
p
            | Bool
otherwise = forall a. Time -> Pattern a -> Pattern a
_fast (Time
1forall a. Fractional a => a -> a -> a
/Time
n) forall a b. (a -> b) -> a -> b
$ forall a. Arc -> Pattern a -> Pattern a
zoomArc (forall a. a -> a -> ArcF a
Arc Time
0 Time
n) Pattern a
p

{- |
Use `within` to apply a function to only a part of a pattern. For example, to
apply `density 2` to only the first half of a pattern:

@
d1 $ within (0, 0.5) (density 2) $ sound "bd*2 sn lt mt hh hh hh hh"
@

Or, to apply `(# speed "0.5") to only the last quarter of a pattern:

@
d1 $ within (0.75, 1) (# speed "0.5") $ sound "bd*2 sn lt mt hh hh hh hh"
@
-}
within :: (Time, Time) -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
within :: forall a.
(Time, Time) -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
within (Time
s, Time
e) Pattern a -> Pattern a
f Pattern a
p = forall a. [Pattern a] -> Pattern a
stack [forall a. (Time -> Bool) -> Pattern a -> Pattern a
filterWhen (\Time
t -> Time -> Time
cyclePos Time
t forall a. Ord a => a -> a -> Bool
>= Time
s Bool -> Bool -> Bool
&& Time -> Time
cyclePos Time
t forall a. Ord a => a -> a -> Bool
< Time
e) forall a b. (a -> b) -> a -> b
$ Pattern a -> Pattern a
f Pattern a
p,
                           forall a. (Time -> Bool) -> Pattern a -> Pattern a
filterWhen (\Time
t -> Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Time -> Time
cyclePos Time
t forall a. Ord a => a -> a -> Bool
>= Time
s Bool -> Bool -> Bool
&& Time -> Time
cyclePos Time
t forall a. Ord a => a -> a -> Bool
< Time
e) Pattern a
p
                          ]

withinArc :: Arc -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
withinArc :: forall a. Arc -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
withinArc (Arc Time
s Time
e) = forall a.
(Time, Time) -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
within (Time
s, Time
e)

{- |
For many cases, @within'@ will function exactly as within.
The difference between the two occurs when applying functions that change the timing of notes such as 'fast' or '<~'.
within first applies the function to all notes in the cycle, then keeps the results in the specified interval, and then combines it with the old cycle (an "apply split combine" paradigm).
within' first keeps notes in the specified interval, then applies the function to these notes, and then combines it with the old cycle (a "split apply combine" paradigm).


For example, whereas using the standard version of within

@
d1 $ within (0, 0.25) (fast 2) $ sound "bd hh cp sd"
@

sounds like:

@
d1 $ sound "[bd hh] hh cp sd"
@

using this alternative version, within'

@
d1 $ within' (0, 0.25) (fast 2) $ sound "bd hh cp sd"
@

sounds like:

@
d1 $ sound "[bd bd] hh cp sd"
@

-}
within' :: (Time, Time) -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
within' :: forall a.
(Time, Time) -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
within' a :: (Time, Time)
a@(Time
s, Time
e) Pattern a -> Pattern a
f Pattern a
p =
  forall a. [Pattern a] -> Pattern a
stack [ forall a. (Time -> Bool) -> Pattern a -> Pattern a
filterWhen (\Time
t -> Time -> Time
cyclePos Time
t forall a. Ord a => a -> a -> Bool
>= Time
s Bool -> Bool -> Bool
&& Time -> Time
cyclePos Time
t forall a. Ord a => a -> a -> Bool
< Time
e) forall a b. (a -> b) -> a -> b
$ forall a. (Time, Time) -> Pattern a -> Pattern a
compress (Time, Time)
a forall a b. (a -> b) -> a -> b
$ Pattern a -> Pattern a
f forall a b. (a -> b) -> a -> b
$ forall a. (Time, Time) -> Pattern a -> Pattern a
zoom (Time, Time)
a Pattern a
p
        , forall a. (Time -> Bool) -> Pattern a -> Pattern a
filterWhen (\Time
t -> Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Time -> Time
cyclePos Time
t forall a. Ord a => a -> a -> Bool
>= Time
s Bool -> Bool -> Bool
&& Time -> Time
cyclePos Time
t forall a. Ord a => a -> a -> Bool
< Time
e) Pattern a
p
        ]

revArc :: (Time, Time) -> Pattern a -> Pattern a
revArc :: forall a. (Time, Time) -> Pattern a -> Pattern a
revArc (Time, Time)
a = forall a.
(Time, Time) -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
within (Time, Time)
a forall a. Pattern a -> Pattern a
rev

{- | You can use the @e@ function to apply a Euclidean algorithm over a
complex pattern, although the structure of that pattern will be lost:

@
d1 $ e 3 8 $ sound "bd*2 [sn cp]"
@

In the above, three sounds are picked from the pattern on the right according
to the structure given by the `e 3 8`. It ends up picking two `bd` sounds, a
`cp` and missing the `sn` entirely.

A negative first argument provides the inverse of the euclidean pattern.

These types of sequences use "Bjorklund's algorithm", which wasn't made for
music but for an application in nuclear physics, which is exciting. More
exciting still is that it is very similar in structure to the one of the first
known algorithms written in Euclid's book of elements in 300 BC. You can read
more about this in the paper
[The Euclidean Algorithm Generates Traditional Musical Rhythms](http://cgm.cs.mcgill.ca/~godfried/publications/banff.pdf)
by Toussaint. Some examples from this paper are included below,
including rotation in some cases.

@
- (2,5) : A thirteenth century Persian rhythm called Khafif-e-ramal.
- (3,4) : The archetypal pattern of the Cumbia from Colombia, as well as a Calypso rhythm from Trinidad.
- (3,5,2) : Another thirteenth century Persian rhythm by the name of Khafif-e-ramal, as well as a Rumanian folk-dance rhythm.
- (3,7) : A Ruchenitza rhythm used in a Bulgarian folk-dance.
- (3,8) : The Cuban tresillo pattern.
- (4,7) : Another Ruchenitza Bulgarian folk-dance rhythm.
- (4,9) : The Aksak rhythm of Turkey.
- (4,11) : The metric pattern used by Frank Zappa in his piece titled Outside Now.
- (5,6) : Yields the York-Samai pattern, a popular Arab rhythm.
- (5,7) : The Nawakhat pattern, another popular Arab rhythm.
- (5,8) : The Cuban cinquillo pattern.
- (5,9) : A popular Arab rhythm called Agsag-Samai.
- (5,11) : The metric pattern used by Moussorgsky in Pictures at an Exhibition.
- (5,12) : The Venda clapping pattern of a South African children’s song.
- (5,16) : The Bossa-Nova rhythm necklace of Brazil.
- (7,8) : A typical rhythm played on the Bendir (frame drum).
- (7,12) : A common West African bell pattern.
- (7,16,14) : A Samba rhythm necklace from Brazil.
- (9,16) : A rhythm necklace used in the Central African Republic.
- (11,24,14) : A rhythm necklace of the Aka Pygmies of Central Africa.
- (13,24,5) : Another rhythm necklace of the Aka Pygmies of the upper Sangha.
@
-}
euclid :: Pattern Int -> Pattern Int -> Pattern a -> Pattern a
euclid :: forall a. Pattern Int -> Pattern Int -> Pattern a -> Pattern a
euclid = forall a b c d.
(a -> b -> c -> Pattern d)
-> Pattern a -> Pattern b -> c -> Pattern d
tParam2 forall a. Int -> Int -> Pattern a -> Pattern a
_euclid

_euclid :: Int -> Int -> Pattern a -> Pattern a
_euclid :: forall a. Int -> Int -> Pattern a -> Pattern a
_euclid Int
n Int
k Pattern a
a | Int
n forall a. Ord a => a -> a -> Bool
>= Int
0 = forall a. [Pattern a] -> Pattern a
fastcat forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> a -> Bool -> a
bool forall a. Pattern a
silence Pattern a
a) forall a b. (a -> b) -> a -> b
$ (Int, Int) -> [Bool]
bjorklund (Int
n,Int
k)
              | Bool
otherwise = forall a. [Pattern a] -> Pattern a
fastcat forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> a -> Bool -> a
bool Pattern a
a forall a. Pattern a
silence) forall a b. (a -> b) -> a -> b
$ (Int, Int) -> [Bool]
bjorklund (-Int
n,Int
k)

{- | `euclidfull n k pa pb` stacks @e n k pa@ with @einv n k pb@ -}
euclidFull :: Pattern Int -> Pattern Int -> Pattern a -> Pattern a -> Pattern a
euclidFull :: forall a.
Pattern Int -> Pattern Int -> Pattern a -> Pattern a -> Pattern a
euclidFull Pattern Int
n Pattern Int
k Pattern a
pa Pattern a
pb = forall a. [Pattern a] -> Pattern a
stack [ forall a. Pattern Int -> Pattern Int -> Pattern a -> Pattern a
euclid Pattern Int
n Pattern Int
k Pattern a
pa, forall a. Pattern Int -> Pattern Int -> Pattern a -> Pattern a
euclidInv Pattern Int
n Pattern Int
k Pattern a
pb ]

_euclidBool :: Int -> Int -> Pattern Bool
_euclidBool :: Int -> Int -> Pattern Bool
_euclidBool Int
n Int
k = forall a. [a] -> Pattern a
fastFromList forall a b. (a -> b) -> a -> b
$ (Int, Int) -> [Bool]
bjorklund (Int
n,Int
k)

_euclid' :: Int -> Int -> Pattern a -> Pattern a
_euclid' :: forall a. Int -> Int -> Pattern a -> Pattern a
_euclid' Int
n Int
k Pattern a
p = forall a. [Pattern a] -> Pattern a
fastcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Bool
x -> if Bool
x then Pattern a
p else forall a. Pattern a
silence) ((Int, Int) -> [Bool]
bjorklund (Int
n,Int
k))

euclidOff :: Pattern Int -> Pattern Int -> Pattern Int -> Pattern a -> Pattern a
euclidOff :: forall a.
Pattern Int -> Pattern Int -> Pattern Int -> Pattern a -> Pattern a
euclidOff = forall a b c d e.
(a -> b -> c -> Pattern d -> Pattern e)
-> Pattern a -> Pattern b -> Pattern c -> Pattern d -> Pattern e
tParam3 forall a. Int -> Int -> Int -> Pattern a -> Pattern a
_euclidOff

eoff :: Pattern Int -> Pattern Int -> Pattern Int -> Pattern a -> Pattern a
eoff :: forall a.
Pattern Int -> Pattern Int -> Pattern Int -> Pattern a -> Pattern a
eoff = forall a.
Pattern Int -> Pattern Int -> Pattern Int -> Pattern a -> Pattern a
euclidOff

_euclidOff :: Int -> Int -> Int -> Pattern a -> Pattern a
_euclidOff :: forall a. Int -> Int -> Int -> Pattern a -> Pattern a
_euclidOff Int
_ Int
0 Int
_ Pattern a
_ = forall a. Pattern a
silence
_euclidOff Int
n Int
k Int
s Pattern a
p = (forall a. Time -> Pattern a -> Pattern a
rotL forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sforall a. Integral a => a -> a -> Ratio a
%forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k) (forall a. Int -> Int -> Pattern a -> Pattern a
_euclid Int
n Int
k Pattern a
p)

euclidOffBool :: Pattern Int -> Pattern Int -> Pattern Int -> Pattern Bool -> Pattern Bool
euclidOffBool :: Pattern Int
-> Pattern Int -> Pattern Int -> Pattern Bool -> Pattern Bool
euclidOffBool = forall a b c d e.
(a -> b -> c -> Pattern d -> Pattern e)
-> Pattern a -> Pattern b -> Pattern c -> Pattern d -> Pattern e
tParam3 Int -> Int -> Int -> Pattern Bool -> Pattern Bool
_euclidOffBool

_euclidOffBool :: Int -> Int -> Int -> Pattern Bool -> Pattern Bool
_euclidOffBool :: Int -> Int -> Int -> Pattern Bool -> Pattern Bool
_euclidOffBool Int
_ Int
0 Int
_ Pattern Bool
_ = forall a. Pattern a
silence
_euclidOffBool Int
n Int
k Int
s Pattern Bool
p = ((forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s forall a. Integral a => a -> a -> Ratio a
% forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k) forall a. Time -> Pattern a -> Pattern a
`rotL`) ((\Bool
a Bool
b -> if Bool
b then Bool
a else Bool -> Bool
not Bool
a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> Pattern Bool
_euclidBool Int
n Int
k forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pattern Bool
p)

distrib :: [Pattern Int] -> Pattern a -> Pattern a
distrib :: forall a. [Pattern Int] -> Pattern a -> Pattern a
distrib [Pattern Int]
ps Pattern a
p = do [Int]
p' <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Pattern Int]
ps
                  forall a. [Int] -> Pattern a -> Pattern a
_distrib [Int]
p' Pattern a
p

_distrib :: [Int] -> Pattern a -> Pattern a
_distrib :: forall a. [Int] -> Pattern a -> Pattern a
_distrib [Int]
xs Pattern a
p = forall {b}. [Bool] -> Pattern b -> Pattern b
boolsToPat (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [Bool] -> [Bool] -> [Bool]
distrib' (forall a. Int -> a -> [a]
replicate (forall a. [a] -> a
last [Int]
xs) Bool
True) (forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ [Int] -> [[Bool]]
layers [Int]
xs)) Pattern a
p
  where
    distrib' :: [Bool] -> [Bool] -> [Bool]
    distrib' :: [Bool] -> [Bool] -> [Bool]
distrib' [] [Bool]
_ = []
    distrib' (Bool
_:[Bool]
a) [] = Bool
False forall a. a -> [a] -> [a]
: [Bool] -> [Bool] -> [Bool]
distrib' [Bool]
a []
    distrib' (Bool
True:[Bool]
a) (Bool
x:[Bool]
b) = Bool
x forall a. a -> [a] -> [a]
: [Bool] -> [Bool] -> [Bool]
distrib' [Bool]
a [Bool]
b
    distrib' (Bool
False:[Bool]
a) [Bool]
b = Bool
False forall a. a -> [a] -> [a]
: [Bool] -> [Bool] -> [Bool]
distrib' [Bool]
a [Bool]
b
    layers :: [Int] -> [[Bool]]
layers = forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> [Bool]
bjorklund forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. [a] -> [b] -> [(a, b)]
zipforall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>forall a. [a] -> [a]
tail)
    boolsToPat :: [Bool] -> Pattern b -> Pattern b
boolsToPat [Bool]
a Pattern b
b' = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. a -> b -> a
const forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (a -> Bool) -> Pattern a -> Pattern a
filterValues (forall a. Eq a => a -> a -> Bool
== Bool
True) (forall a. [a] -> Pattern a
fastFromList [Bool]
a) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pattern b
b'

{- | `euclidInv` fills in the blanks left by `e`
 -
 @e 3 8 "x"@ -> @"x ~ ~ x ~ ~ x ~"@

 @euclidInv 3 8 "x"@ -> @"~ x x ~ x x ~ x"@
-}
euclidInv :: Pattern Int -> Pattern Int -> Pattern a -> Pattern a
euclidInv :: forall a. Pattern Int -> Pattern Int -> Pattern a -> Pattern a
euclidInv = forall a b c d.
(a -> b -> c -> Pattern d)
-> Pattern a -> Pattern b -> c -> Pattern d
tParam2 forall a. Int -> Int -> Pattern a -> Pattern a
_euclidInv

_euclidInv :: Int -> Int -> Pattern a -> Pattern a
_euclidInv :: forall a. Int -> Int -> Pattern a -> Pattern a
_euclidInv Int
n Int
k Pattern a
a = forall a. Int -> Int -> Pattern a -> Pattern a
_euclid (-Int
n) Int
k Pattern a
a

index :: Real b => b -> Pattern b -> Pattern c -> Pattern c
index :: forall b c. Real b => b -> Pattern b -> Pattern c -> Pattern c
index b
sz Pattern b
indexpat Pattern c
pat =
  forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> m c) -> m a -> b -> m c
spread' (forall a. Time -> Time -> Pattern a -> Pattern a
zoom' forall a b. (a -> b) -> a -> b
$ forall a. Real a => a -> Time
toRational b
sz) (forall a. Real a => a -> Time
toRational forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
*(b
1forall a. Num a => a -> a -> a
-b
sz)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern b
indexpat) Pattern c
pat
  where
    zoom' :: Time -> Time -> Pattern a -> Pattern a
zoom' Time
tSz Time
s = forall a. Arc -> Pattern a -> Pattern a
zoomArc (forall a. a -> a -> ArcF a
Arc Time
s (Time
sforall a. Num a => a -> a -> a
+Time
tSz))

{-
-- | @prrw f rot (blen, vlen) beatPattern valuePattern@: pattern rotate/replace.
prrw :: (a -> b -> c) -> Int -> (Time, Time) -> Pattern a -> Pattern b -> Pattern c
prrw f rot (blen, vlen) beatPattern valuePattern =
  let
    ecompare (_,e1,_) (_,e2,_) = compare (fst e1) (fst e2)
    beats  = sortBy ecompare $ arc beatPattern (0, blen)
    values = fmap thd' . sortBy ecompare $ arc valuePattern (0, vlen)
    cycles = blen * (fromIntegral $ lcm (length beats) (length values) `div` (length beats))
  in
    _slow cycles $ stack $ zipWith
    (\( _, (start, end), v') v -> (start `rotR`) $ densityGap (1 / (end - start)) $ pure (f v' v))
    (sortBy ecompare $ arc (_fast cycles $ beatPattern) (0, blen))
    (drop (rot `mod` length values) $ cycle values)

-- | @prr rot (blen, vlen) beatPattern valuePattern@: pattern rotate/replace.
prr :: Int -> (Time, Time) -> Pattern String -> Pattern b -> Pattern b
prr = prrw $ flip const

{-|
@preplace (blen, plen) beats values@ combines the timing of @beats@ with the values
of @values@. Other ways of saying this are:
* sequential convolution
* @values@ quantized to @beats@.

Examples:

@
d1 $ sound $ preplace (1,1) "x [~ x] x x" "bd sn"
d1 $ sound $ preplace (1,1) "x(3,8)" "bd sn"
d1 $ sound $ "x(3,8)" <~> "bd sn"
d1 $ sound "[jvbass jvbass:5]*3" |+| (shape $ "1 1 1 1 1" <~> "0.2 0.9")
@

It is assumed the pattern fits into a single cycle. This works well with
pattern literals, but not always with patterns defined elsewhere. In those cases
use @preplace@ and provide desired pattern lengths:
@
let p = slow 2 $ "x x x"

d1 $ sound $ preplace (2,1) p "bd sn"
@
-}
preplace :: (Time, Time) -> Pattern String -> Pattern b -> Pattern b
preplace = preplaceWith $ flip const

-- | @prep@ is an alias for preplace.
prep :: (Time, Time) -> Pattern String -> Pattern b -> Pattern b
prep = preplace

preplace1 :: Pattern String -> Pattern b -> Pattern b
preplace1 = preplace (1, 1)

preplaceWith :: (a -> b -> c) -> (Time, Time) -> Pattern a -> Pattern b -> Pattern c
preplaceWith f (blen, plen) = prrw f 0 (blen, plen)

prw :: (a -> b -> c) -> (Time, Time) -> Pattern a -> Pattern b -> Pattern c
prw = preplaceWith

preplaceWith1 :: (a -> b -> c) -> Pattern a -> Pattern b -> Pattern c
preplaceWith1 f = prrw f 0 (1, 1)

prw1 :: (a -> b -> c) -> Pattern a -> Pattern b -> Pattern c
prw1 = preplaceWith1

(<~>) :: Pattern String -> Pattern b -> Pattern b
(<~>) = preplace (1, 1)

-- | @protate len rot p@ rotates pattern @p@ by @rot@ beats to the left.
-- @len@: length of the pattern, in cycles.
-- Example: @d1 $ every 4 (protate 2 (-1)) $ slow 2 $ sound "bd hh hh hh"@
protate :: Time -> Int -> Pattern a -> Pattern a
protate len rot p = prrw (flip const) rot (len, len) p p

prot :: Time -> Int -> Pattern a -> Pattern a
prot = protate

prot1 :: Int -> Pattern a -> Pattern a
prot1 = protate 1

{-| The @<<~@ operator rotates a unit pattern to the left, similar to @<~@,
but by events rather than linear time. The timing of the pattern remains constant:

@
d1 $ (1 <<~) $ sound "bd ~ sn hh"
-- will become
d1 $ sound "sn ~ hh bd"
@ -}

(<<~) :: Int -> Pattern a -> Pattern a
(<<~) = protate 1

-- | @~>>@ is like @<<~@ but for shifting to the right.
(~>>) :: Int -> Pattern a -> Pattern a
(~>>) = (<<~) . (0-)

-- | @pequal cycles p1 p2@: quickly test if @p1@ and @p2@ are the same.
pequal :: Ord a => Time -> Pattern a -> Pattern a -> Bool
pequal cycles p1 p2 = (sort $ arc p1 (0, cycles)) == (sort $ arc p2 (0, cycles))
-}

-- | @rot n p@ rotates the values in a pattern @p@ by @n@ beats to the left.
-- Example: @d1 $ every 4 (rot 2) $ slow 2 $ sound "bd hh hh hh"@
rot :: Ord a => Pattern Int -> Pattern a -> Pattern a
rot :: forall a. Ord a => Pattern Int -> Pattern a -> Pattern a
rot = forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam forall a. Ord a => Int -> Pattern a -> Pattern a
_rot

-- Calculates a whole cycle, rotates it, then constrains events to the original query arc
_rot :: Ord a => Int -> Pattern a -> Pattern a
_rot :: forall a. Ord a => Int -> Pattern a -> Pattern a
_rot Int
i Pattern a
pat = forall a. Pattern a -> Pattern a
splitQueries forall a b. (a -> b) -> a -> b
$ Pattern a
pat {query :: State -> [Event a]
query = \State
st -> forall {a}. Ord a => State -> [Event a] -> [Event a]
f State
st (forall a. Pattern a -> State -> [Event a]
query Pattern a
pat (State
st {arc :: Arc
arc = Arc -> Arc
wholeCycle (State -> Arc
arc State
st)}))}
  where -- TODO maybe events with the same arc (part+whole) should be
        -- grouped together in the rotation?
        f :: State -> [Event a] -> [Event a]
f State
st [Event a]
es = forall a. Arc -> [Event a] -> [Event a]
constrainEvents (State -> Arc
arc State
st) forall a b. (a -> b) -> a -> b
$ forall {a} {b}. [EventF a b] -> [EventF a b]
shiftValues forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [Event a] -> [Event a]
defragParts [Event a]
es
        shiftValues :: [EventF a b] -> [EventF a b]
shiftValues [EventF a b]
es | Int
i forall a. Ord a => a -> a -> Bool
>= Int
0 =
                         forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\EventF a b
e b
s -> EventF a b
e {value :: b
value = b
s}) [EventF a b]
es
                         (forall a. Int -> [a] -> [a]
drop Int
i forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
cycle forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. EventF a b -> b
value [EventF a b]
es)
                       | Bool
otherwise =
                         forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\EventF a b
e b
s -> EventF a b
e{value :: b
value = b
s}) [EventF a b]
es
                         (forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length [EventF a b]
es forall a. Num a => a -> a -> a
- forall a. Num a => a -> a
abs Int
i) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
cycle forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. EventF a b -> b
value [EventF a b]
es)
        wholeCycle :: Arc -> Arc
wholeCycle (Arc Time
s Time
_) = forall a. a -> a -> ArcF a
Arc (Time -> Time
sam Time
s) (Time -> Time
nextSam Time
s)
        constrainEvents :: Arc -> [Event a] -> [Event a]
        constrainEvents :: forall a. Arc -> [Event a] -> [Event a]
constrainEvents Arc
a [Event a]
es = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall a. Arc -> Event a -> Maybe (Event a)
constrainEvent Arc
a) [Event a]
es
        constrainEvent :: Arc -> Event a -> Maybe (Event a)
        constrainEvent :: forall a. Arc -> Event a -> Maybe (Event a)
constrainEvent Arc
a Event a
e =
          do
            Arc
p' <- Arc -> Arc -> Maybe Arc
subArc (forall a b. EventF a b -> a
part Event a
e) Arc
a
            forall (m :: * -> *) a. Monad m => a -> m a
return Event a
e {part :: Arc
part = Arc
p'}

-- | @segment n p@: 'samples' the pattern @p@ at a rate of @n@
-- events per cycle. Useful for turning a continuous pattern into a
-- discrete one.
segment :: Pattern Time -> Pattern a -> Pattern a
segment :: forall a. Pattern Time -> Pattern a -> Pattern a
segment = forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam forall a. Time -> Pattern a -> Pattern a
_segment

_segment :: Time -> Pattern a -> Pattern a
_segment :: forall a. Time -> Pattern a -> Pattern a
_segment Time
n Pattern a
p = forall a. Time -> Pattern a -> Pattern a
_fast Time
n (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. a -> a
id) forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
<* Pattern a
p

-- | @discretise@: the old (deprecated) name for 'segment'
discretise :: Pattern Time -> Pattern a -> Pattern a
discretise :: forall a. Pattern Time -> Pattern a -> Pattern a
discretise = forall a. Pattern Time -> Pattern a -> Pattern a
segment

-- | @randcat ps@: does a @slowcat@ on the list of patterns @ps@ but
-- randomises the order in which they are played.
randcat :: [Pattern a] -> Pattern a
randcat :: forall a. [Pattern a] -> Pattern a
randcat [Pattern a]
ps = forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> m c) -> m a -> b -> m c
spread' forall a. Time -> Pattern a -> Pattern a
rotL (forall a. Time -> Pattern a -> Pattern a
_segment Time
1 forall a b. (a -> b) -> a -> b
$ (forall a. Integral a => a -> a -> Ratio a
% Integer
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Num a => Int -> Pattern a
_irand (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pattern a]
ps) :: Pattern Int)) (forall a. [Pattern a] -> Pattern a
slowcat [Pattern a]
ps)

wrandcat :: [(Pattern a, Double)] -> Pattern a
wrandcat :: forall a. [(Pattern a, Double)] -> Pattern a
wrandcat [(Pattern a, Double)]
ps = forall a. Pattern (Pattern a) -> Pattern a
unwrap forall a b. (a -> b) -> a -> b
$ forall a. Pattern Double -> [(a, Double)] -> Pattern a
wchooseBy (forall a. Pattern Time -> Pattern a -> Pattern a
segment Pattern Time
1 forall a. Fractional a => Pattern a
rand) [(Pattern a, Double)]
ps

-- @fromNote p@: converts a pattern of human-readable pitch names
-- into pitch numbers. For example, @"cs2"@ will be parsed as C Sharp
-- in the 2nd octave with the result of @11@, and @"b-3"@ as
-- @-25@. Pitches can be decorated using:
--
--    * s = Sharp, a half-step above (@"gs-1"@)
--    * f = Flat, a half-step below (@"gf-1"@)
--    * n = Natural, no decoration (@"g-1" and "gn-1"@ are equivalent)
--    * ss = Double sharp, a whole step above (@"gss-1"@)
--    * ff = Double flat, a whole step below (@"gff-1"@)
--
-- Note that TidalCycles now assumes that middle C is represented by
-- the value 0, rather than the previous value of 60. This function
-- is similar to previously available functions @tom@ and @toMIDI@,
-- but the default octave is now 0 rather than 5.
{-

definition moved to Parse.hs ..

toMIDI :: Pattern String -> Pattern Int
toMIDI p = fromJust <$> (filterValues (isJust) (noteLookup <$> p))
  where
    noteLookup :: String -> Maybe Int
    noteLookup [] = Nothing
    noteLookup s | not (last s `elem` ['0' .. '9']) = noteLookup (s ++ "0")
                 | not (isLetter (s !! 1)) = noteLookup((head s):'n':(tail s))
                 | otherwise = parse s
    parse x = (\a b c -> a+b+c) <$> pc x <*> sym x <*> Just(12*digitToInt (last x))
    pc x = lookup (head x) [('c',0),('d',2),('e',4),('f',5),('g',7),('a',9),('b',11)]
    sym x = lookup (init (tail x)) [("s",1),("f",-1),("n",0),("ss",2),("ff",-2)]
-}

-- @tom p@: Alias for @toMIDI@.
-- tom = toMIDI


{- | The `fit` function takes a pattern of integer numbers, which are used to select values from the given list. What makes this a bit strange is that only a given number of values are selected each cycle. For example:

@
d1 $ sound (fit 3 ["bd", "sn", "arpy", "arpy:1", "casio"] "0 [~ 1] 2 1")
@

The above fits three samples into the pattern, i.e. for the first cycle this will be `"bd"`, `"sn"` and `"arpy"`, giving the result `"bd [~ sn] arpy sn"` (note that we start counting at zero, so that `0` picks the first value). The following cycle the *next* three values in the list will be picked, i.e. `"arpy:1"`, `"casio"` and `"bd"`, giving the pattern `"arpy:1 [~ casio] bd casio"` (note that the list wraps round here).

-}
_fit :: Int -> [a] -> Pattern Int -> Pattern a
_fit :: forall a. Int -> [a] -> Pattern Int -> Pattern a
_fit Int
perCycle [a]
xs Pattern Int
p = ([a]
xs forall a. [a] -> Int -> a
!!!) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Pattern Int
p {query :: State -> [Event Int]
query = forall a b. (a -> b) -> [a] -> [b]
map (\Event Int
e -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Num a => a -> a -> a
+ forall {a} {b}. RealFrac a => EventF (ArcF a) b -> Int
pos Event Int
e) Event Int
e) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pattern a -> State -> [Event a]
query Pattern Int
p})
  where pos :: EventF (ArcF a) b -> Int
pos EventF (ArcF a) b
e = Int
perCycle forall a. Num a => a -> a -> a
* forall a b. (RealFrac a, Integral b) => a -> b
floor (forall a. ArcF a -> a
start forall a b. (a -> b) -> a -> b
$ forall a b. EventF a b -> a
part EventF (ArcF a) b
e)

fit :: Pattern Int -> [a] -> Pattern Int -> Pattern a
fit :: forall a. Pattern Int -> [a] -> Pattern Int -> Pattern a
fit Pattern Int
pint [a]
xs Pattern Int
p = (forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam forall {a}. Int -> ([a], Pattern Int) -> Pattern a
func) Pattern Int
pint ([a]
xs,Pattern Int
p)
  where func :: Int -> ([a], Pattern Int) -> Pattern a
func Int
i ([a]
xs',Pattern Int
p') = forall a. Int -> [a] -> Pattern Int -> Pattern a
_fit Int
i [a]
xs' Pattern Int
p'

permstep :: RealFrac b => Int -> [a] -> Pattern b -> Pattern a
permstep :: forall b a. RealFrac b => Int -> [a] -> Pattern b -> Pattern a
permstep Int
nSteps [a]
things Pattern b
p = forall a. Pattern (Pattern a) -> Pattern a
unwrap forall a b. (a -> b) -> a -> b
$ (\b
n -> forall a. [a] -> Pattern a
fastFromList forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Int, a)
x -> forall a. Int -> a -> [a]
replicate (forall a b. (a, b) -> a
fst (Int, a)
x) (forall a b. (a, b) -> b
snd (Int, a)
x)) forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip ([[Int]]
ps forall a. [a] -> Int -> a
!! forall a b. (RealFrac a, Integral b) => a -> b
floor (b
n forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Int]]
ps forall a. Num a => a -> a -> a
- Int
1))) [a]
things) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Time -> Pattern a -> Pattern a
_segment Time
1 Pattern b
p
      where ps :: [[Int]]
ps = forall {a}. Integral a => a -> a -> [[a]]
permsort (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
things) Int
nSteps
            deviance :: a -> [a] -> a
deviance a
avg [a]
xs = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. Num a => a -> a
abs forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
avgforall a. Num a => a -> a -> a
-) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) [a]
xs
            permsort :: a -> a -> [[a]]
permsort a
n a
total = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\[a]
x -> ([a]
x,forall {a} {a}. (Integral a, Num a) => a -> [a] -> a
deviance (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
total forall a. Fractional a => a -> a -> a
/ (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n :: Double)) [a]
x)) forall a b. (a -> b) -> a -> b
$ forall {t}. (Eq t, Num t, Enum t) => t -> t -> [[t]]
perms a
n a
total
            perms :: t -> t -> [[t]]
perms t
0 t
_ = []
            perms t
1 t
n = [[t
n]]
            perms t
n t
total = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\t
x -> forall a b. (a -> b) -> [a] -> [b]
map (t
xforall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$ t -> t -> [[t]]
perms (t
nforall a. Num a => a -> a -> a
-t
1) (t
totalforall a. Num a => a -> a -> a
-t
x)) [t
1 .. (t
totalforall a. Num a => a -> a -> a
-(t
nforall a. Num a => a -> a -> a
-t
1))]

-- | @struct a b@: structures pattern @b@ in terms of the pattern of
-- boolean values @a@. Only @True@ values in the boolean pattern are
-- used.
struct :: Pattern Bool -> Pattern a -> Pattern a
struct :: forall a. Pattern Bool -> Pattern a -> Pattern a
struct Pattern Bool
ps Pattern a
pv = forall a. Pattern (Maybe a) -> Pattern a
filterJust forall a b. (a -> b) -> a -> b
$ (\Bool
a a
b -> if Bool
a then forall a. a -> Maybe a
Just a
b else forall a. Maybe a
Nothing ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Bool
ps forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
<* Pattern a
pv

-- | @substruct a b@: similar to @struct@, but each event in pattern @a@ gets replaced with pattern @b@, compressed to fit the timespan of the event.
substruct :: Pattern Bool -> Pattern b -> Pattern b
substruct :: forall a. Pattern Bool -> Pattern a -> Pattern a
substruct Pattern Bool
s Pattern b
p = Pattern b
p {query :: State -> [Event b]
query = State -> [Event b]
f}
  where f :: State -> [Event b]
f State
st =
          forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((\Arc
a' -> forall a. Pattern a -> Arc -> [Event a]
queryArc (forall a. Arc -> Pattern a -> Pattern a
compressArcTo Arc
a' Pattern b
p) Arc
a') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Event a -> Arc
wholeOrPart) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter forall a b. EventF a b -> b
value forall a b. (a -> b) -> a -> b
$ forall a. Pattern a -> State -> [Event a]
query Pattern Bool
s State
st

randArcs :: Int -> Pattern [Arc]
randArcs :: Int -> Pattern [Arc]
randArcs Int
n =
  do [Int]
rs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Int
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Real a => a -> Time
toRational Int
x forall a. Fractional a => a -> a -> a
/ forall a. Real a => a -> Time
toRational Int
n) forall a. Pattern Time -> Pattern a -> Pattern a
<~ forall a. [a] -> Pattern a
choose [Int
1 :: Int,Int
2,Int
3]) [Int
0 .. (Int
nforall a. Num a => a -> a -> a
-Int
1)]
     let rats :: [Time]
rats = forall a b. (a -> b) -> [a] -> [b]
map forall a. Real a => a -> Time
toRational [Int]
rs
         total :: Time
total = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Time]
rats
         pairs :: [Arc]
pairs = forall {a}. Num a => [a] -> [ArcF a]
pairUp forall a b. (a -> b) -> a -> b
$ forall t. Num t => [t] -> [t]
accumulate forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. Fractional a => a -> a -> a
/Time
total) [Time]
rats
     forall (m :: * -> *) a. Monad m => a -> m a
return [Arc]
pairs
       where pairUp :: [a] -> [ArcF a]
pairUp [] = []
             pairUp [a]
xs = forall a. a -> a -> ArcF a
Arc a
0 (forall a. [a] -> a
head [a]
xs) forall a. a -> [a] -> [a]
: forall {a}. Num a => [a] -> [ArcF a]
pairUp' [a]
xs
             pairUp' :: [a] -> [ArcF a]
pairUp' [] = []
             pairUp' [a
_] = []
             pairUp' [a
a, a
_] = [forall a. a -> a -> ArcF a
Arc a
a a
1]
             pairUp' (a
a:a
b:[a]
xs) = forall a. a -> a -> ArcF a
Arc a
a a
bforall a. a -> [a] -> [a]
: [a] -> [ArcF a]
pairUp' (a
bforall a. a -> [a] -> [a]
:[a]
xs)


-- TODO - what does this do? Something for @stripe@ ..
randStruct :: Int -> Pattern Int
randStruct :: Int -> Pattern Int
randStruct Int
n = forall a. Pattern a -> Pattern a
splitQueries forall a b. (a -> b) -> a -> b
$ Pattern {query :: State -> [Event Int]
query = State -> [Event Int]
f}
  where f :: State -> [Event Int]
f State
st = forall a b. (a -> b) -> [a] -> [b]
map (\(Arc
a,Maybe Arc
b,Int
c) -> forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event ([((Int, Int), (Int, Int))] -> Context
Context []) (forall a. a -> Maybe a
Just Arc
a) (forall a. HasCallStack => Maybe a -> a
fromJust Maybe Arc
b) Int
c) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (\(Arc
_,Maybe Arc
x,Int
_) -> forall a. Maybe a -> Bool
isJust Maybe Arc
x) [(Arc, Maybe Arc, Int)]
as
          where as :: [(Arc, Maybe Arc, Int)]
as = forall a b. (a -> b) -> [a] -> [b]
map (\(Int
i, Arc Time
s' Time
e') ->
                    (forall a. a -> a -> ArcF a
Arc (Time
s' forall a. Num a => a -> a -> a
+ Time -> Time
sam Time
s) (Time
e' forall a. Num a => a -> a -> a
+ Time -> Time
sam Time
s),
                       Arc -> Arc -> Maybe Arc
subArc (forall a. a -> a -> ArcF a
Arc Time
s Time
e) (forall a. a -> a -> ArcF a
Arc (Time
s' forall a. Num a => a -> a -> a
+ Time -> Time
sam Time
s) (Time
e' forall a. Num a => a -> a -> a
+ Time -> Time
sam Time
s)), Int
i)) forall a b. (a -> b) -> a -> b
$
                      forall a. [a] -> [(Int, a)]
enumerate forall a b. (a -> b) -> a -> b
$ forall a b. EventF a b -> b
value forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$
                      forall a. Pattern a -> Arc -> [Event a]
queryArc (Int -> Pattern [Arc]
randArcs Int
n) (forall a. a -> a -> ArcF a
Arc (Time -> Time
sam Time
s) (Time -> Time
nextSam Time
s))
                (Arc Time
s Time
e) = State -> Arc
arc State
st

-- TODO - what does this do?
substruct' :: Pattern Int -> Pattern a -> Pattern a
substruct' :: forall c. Pattern Int -> Pattern c -> Pattern c
substruct' Pattern Int
s Pattern a
p = Pattern a
p {query :: State -> [Event a]
query = \State
st -> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall {a}. Real a => State -> EventF Arc a -> [Event a]
f State
st) (forall a. Pattern a -> State -> [Event a]
query Pattern Int
s State
st)}
  where f :: State -> EventF Arc a -> [Event a]
f State
st (Event Context
c (Just Arc
a') Arc
_ a
i) = forall a b. (a -> b) -> [a] -> [b]
map (\Event a
e -> Event a
e {context :: Context
context = [Context] -> Context
combineContexts [Context
c, forall a b. EventF a b -> Context
context Event a
e]}) forall a b. (a -> b) -> a -> b
$ forall a. Pattern a -> Arc -> [Event a]
queryArc (forall a. Arc -> Pattern a -> Pattern a
compressArcTo Arc
a' (forall a1 a.
Pattern Time
-> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
inside (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Time
1forall a. Fractional a => a -> a -> a
/forall a. Real a => a -> Time
toRational(forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. Pattern a -> Arc -> [Event a]
queryArc Pattern Int
s (forall a. a -> a -> ArcF a
Arc (Time -> Time
sam (forall a. ArcF a -> a
start forall a b. (a -> b) -> a -> b
$ State -> Arc
arc State
st)) (Time -> Time
nextSam (forall a. ArcF a -> a
start forall a b. (a -> b) -> a -> b
$ State -> Arc
arc State
st)))))) (forall a. Time -> Pattern a -> Pattern a
rotR (forall a. Real a => a -> Time
toRational a
i)) Pattern a
p)) Arc
a'
        -- Ignore analog events (ones without wholes)
        f State
_ EventF Arc a
_ = []

-- | @stripe n p@: repeats pattern @p@, @n@ times per cycle. So
-- similar to @fast@, but with random durations. The repetitions will
-- be continguous (touching, but not overlapping) and the durations
-- will add up to a single cycle. @n@ can be supplied as a pattern of
-- integers.
stripe :: Pattern Int -> Pattern a -> Pattern a
stripe :: forall c. Pattern Int -> Pattern c -> Pattern c
stripe = forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam forall a. Int -> Pattern a -> Pattern a
_stripe

_stripe :: Int -> Pattern a -> Pattern a
_stripe :: forall a. Int -> Pattern a -> Pattern a
_stripe = forall c. Pattern Int -> Pattern c -> Pattern c
substruct' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Pattern Int
randStruct

-- | @slowstripe n p@: The same as @stripe@, but the result is also
-- @n@ times slower, so that the mean average duration of the stripes
-- is exactly one cycle, and every @n@th stripe starts on a cycle
-- boundary (in indian classical terms, the @sam@).
slowstripe :: Pattern Int -> Pattern a -> Pattern a
slowstripe :: forall c. Pattern Int -> Pattern c -> Pattern c
slowstripe Pattern Int
n = forall a. Pattern Time -> Pattern a -> Pattern a
slow (forall a. Real a => a -> Time
toRational forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Int
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Pattern Int -> Pattern c -> Pattern c
stripe Pattern Int
n

-- Lindenmayer patterns, these go well with the step sequencer
-- general rule parser (strings map to strings)
parseLMRule :: String -> [(String,String)]
parseLMRule :: [Char] -> [([Char], [Char])]
parseLMRule [Char]
s = forall a b. (a -> b) -> [a] -> [b]
map (forall {a}. Eq a => a -> [a] -> ([a], [a])
splitOn Char
':') [[Char]]
commaSplit
  where splitOn :: a -> [a] -> ([a], [a])
splitOn a
sep [a]
str = forall a. Int -> [a] -> ([a], [a])
splitAt (forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> [a] -> Maybe Int
elemIndex a
sep [a]
str)
                            forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= a
sep) [a]
str
        commaSplit :: [[Char]]
commaSplit = forall a b. (a -> b) -> [a] -> [b]
map Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
T.splitOn ([Char] -> Text
T.pack [Char]
",") forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
s

-- specific parser for step sequencer (chars map to string)
-- ruleset in form "a:b,b:ab"
parseLMRule' :: String -> [(Char, String)]
parseLMRule' :: [Char] -> [(Char, [Char])]
parseLMRule' [Char]
str = forall a b. (a -> b) -> [a] -> [b]
map forall {a} {b}. ([a], b) -> (a, b)
fixer forall a b. (a -> b) -> a -> b
$ [Char] -> [([Char], [Char])]
parseLMRule [Char]
str
  where fixer :: ([a], b) -> (a, b)
fixer ([a]
c,b
r) = (forall a. [a] -> a
head [a]
c, b
r)

{- | returns the `n`th iteration of a [Lindenmayer System](https://en.wikipedia.org/wiki/L-system) with given start sequence.

for example:

@
lindenmayer 1 "a:b,b:ab" "ab" -> "bab"
@
-}
lindenmayer :: Int -> String -> String -> String
lindenmayer :: Int -> [Char] -> [Char] -> [Char]
lindenmayer Int
_ [Char]
_ [] = []
lindenmayer Int
1 [Char]
r (Char
c:[Char]
cs) = forall a. a -> Maybe a -> a
fromMaybe [Char
c] (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Char
c forall a b. (a -> b) -> a -> b
$ [Char] -> [(Char, [Char])]
parseLMRule' [Char]
r)
                         forall a. [a] -> [a] -> [a]
++ Int -> [Char] -> [Char] -> [Char]
lindenmayer Int
1 [Char]
r [Char]
cs
lindenmayer Int
n [Char]
r [Char]
s = forall a. (a -> a) -> a -> [a]
iterate (Int -> [Char] -> [Char] -> [Char]
lindenmayer Int
1 [Char]
r) [Char]
s forall a. [a] -> Int -> a
!! Int
n

{- | @lindenmayerI@ converts the resulting string into a a list of integers
with @fromIntegral@ applied (so they can be used seamlessly where floats or
rationals are required) -}
lindenmayerI :: Num b => Int -> String -> String -> [b]
lindenmayerI :: forall b. Num b => Int -> [Char] -> [Char] -> [b]
lindenmayerI Int
n [Char]
r [Char]
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
digitToInt) forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [Char] -> [Char]
lindenmayer Int
n [Char]
r [Char]
s

{- | @runMarkov n tmat xi seed@ generates a Markov chain (as a list) of length @n@
using the transition matrix @tmat@ starting from initial state @xi@, starting
with random numbers generated from @seed@
Each entry in the chain is the index of state (starting from zero).
Each row of the matrix will be automatically normalized. For example:
@
runMarkov 8 [[2,3], [1,3]] 0 0
@
will produce a two-state chain 8 steps long, from initial state @0@, where the
transition probability from state 0->0 is 2/5, 0->1 is 3/5, 1->0 is 1/4, and
1->1 is 3/4.  -}
runMarkov :: Int -> [[Double]] -> Int -> Time -> [Int]
runMarkov :: Int -> [[Double]] -> Int -> Time -> [Int]
runMarkov Int
n [[Double]]
tp Int
xi Time
seed = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ (forall a. (a -> a) -> a -> [a]
iterate (forall {a}. (Ord a, Fractional a) => [[a]] -> [Int] -> [Int]
markovStep forall a b. (a -> b) -> a -> b
$ [[Double]]
renorm) [Int
xi])forall a. [a] -> Int -> a
!! (Int
nforall a. Num a => a -> a -> a
-Int
1) where
  markovStep :: [[a]] -> [Int] -> [Int]
markovStep [[a]]
tp' [Int]
xs = (forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (a
r forall a. Ord a => a -> a -> Bool
<=) forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> a) -> [a] -> [a]
scanl1 forall a. Num a => a -> a -> a
(+) ([[a]]
tp'forall a. [a] -> Int -> a
!!(forall a. [a] -> a
head [Int]
xs))) forall a. a -> [a] -> [a]
: [Int]
xs where
    r :: a
r = forall a b. (RealFrac a, Fractional b) => a -> b
timeToRand forall a b. (a -> b) -> a -> b
$ Time
seed forall a. Num a => a -> a -> a
+ (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length) [Int]
xs forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
  renorm :: [[Double]]
renorm = [ forall a b. (a -> b) -> [a] -> [b]
map (forall a. Fractional a => a -> a -> a
/ forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
x) [Double]
x | [Double]
x <- [[Double]]
tp ]

{- @markovPat n xi tp@ generates a one-cycle pattern of @n@ steps in a Markov
chain starting from state @xi@ with transition matrix @tp@. Each row of the
transition matrix is automatically normalized.  For example:
@
tidal> markovPat 8 1 [[3,5,2], [4,4,2], [0,1,0]]

(0>⅛)|1
(⅛>¼)|2
(¼>⅜)|1
(⅜>½)|1
(½>⅝)|2
(⅝>¾)|1
(¾>⅞)|1
(⅞>1)|0
@ -}
markovPat :: Pattern Int -> Pattern Int -> [[Double]] -> Pattern Int
markovPat :: Pattern Int -> Pattern Int -> [[Double]] -> Pattern Int
markovPat = forall a b c d.
(a -> b -> c -> Pattern d)
-> Pattern a -> Pattern b -> c -> Pattern d
tParam2 Int -> Int -> [[Double]] -> Pattern Int
_markovPat

_markovPat :: Int -> Int -> [[Double]] -> Pattern Int
_markovPat :: Int -> Int -> [[Double]] -> Pattern Int
_markovPat Int
n Int
xi [[Double]]
tp = forall a. Pattern a -> Pattern a
splitQueries forall a b. (a -> b) -> a -> b
$ forall a. (State -> [Event a]) -> Pattern a
Pattern (\(State a :: Arc
a@(Arc Time
s Time
_) ValueMap
_) ->
  forall a. Pattern a -> Arc -> [Event a]
queryArc (forall a. [a] -> Pattern a
listToPat forall a b. (a -> b) -> a -> b
$ Int -> [[Double]] -> Int -> Time -> [Int]
runMarkov Int
n [[Double]]
tp Int
xi (Time -> Time
sam Time
s)) Arc
a)

{-|
Removes events from second pattern that don't start during an event from first.

Consider this, kind of messy rhythm without any rests.

@
d1 $ sound (slowcat ["sn*8", "[cp*4 bd*4, hc*5]"]) # n (run 8)
@

If we apply a mask to it

@
d1 $ s (mask ("1 1 1 ~ 1 1 ~ 1" :: Pattern Bool)
  (slowcat ["sn*8", "[cp*4 bd*4, bass*5]"] ))
  # n (run 8)
@

Due to the use of `slowcat` here, the same mask is first applied to `"sn*8"` and in the next cycle to `"[cp*4 bd*4, hc*5]".

You could achieve the same effect by adding rests within the `slowcat` patterns, but mask allows you to do this more easily. It kind of keeps the rhythmic structure and you can change the used samples independently, e.g.

@
d1 $ s (mask ("1 ~ 1 ~ 1 1 ~ 1")
  (slowcat ["can*8", "[cp*4 sn*4, jvbass*16]"] ))
  # n (run 8)
@
-}
mask :: Pattern Bool -> Pattern a -> Pattern a
mask :: forall a. Pattern Bool -> Pattern a -> Pattern a
mask Pattern Bool
b Pattern a
p = forall a b. a -> b -> a
const forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
p forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
<* (forall a. (a -> Bool) -> Pattern a -> Pattern a
filterValues forall a. a -> a
id Pattern Bool
b)

-- | TODO: refactor towards union
enclosingArc :: [Arc] -> Arc
enclosingArc :: [Arc] -> Arc
enclosingArc [] = forall a. a -> a -> ArcF a
Arc Time
0 Time
1
enclosingArc [Arc]
as = forall a. a -> a -> ArcF a
Arc (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (forall a b. (a -> b) -> [a] -> [b]
map forall a. ArcF a -> a
start [Arc]
as)) (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map forall a. ArcF a -> a
stop [Arc]
as))

stretch :: Pattern a -> Pattern a
-- TODO - should that be whole or part?
stretch :: forall a. Pattern a -> Pattern a
stretch Pattern a
p = forall a. Pattern a -> Pattern a
splitQueries forall a b. (a -> b) -> a -> b
$ Pattern a
p {query :: State -> [Event a]
query = State -> [Event a]
q}
  where q :: State -> [Event a]
q State
st = forall a. Pattern a -> State -> [Event a]
query (forall a. Arc -> Pattern a -> Pattern a
zoomArc (Arc -> Arc
cycleArc forall a b. (a -> b) -> a -> b
$ [Arc] -> Arc
enclosingArc forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Event a -> Arc
wholeOrPart forall a b. (a -> b) -> a -> b
$ forall a. Pattern a -> State -> [Event a]
query Pattern a
p (State
st {arc :: Arc
arc = forall a. a -> a -> ArcF a
Arc (Time -> Time
sam Time
s) (Time -> Time
nextSam Time
s)})) Pattern a
p) State
st
          where s :: Time
s = forall a. ArcF a -> a
start forall a b. (a -> b) -> a -> b
$ State -> Arc
arc State
st

{- | `fit'` is a generalization of `fit`, where the list is instead constructed by using another integer pattern to slice up a given pattern.  The first argument is the number of cycles of that latter pattern to use when slicing.  It's easier to understand this with a few examples:

@
d1 $ sound (fit' 1 2 "0 1" "1 0" "bd sn")
@

So what does this do?  The first `1` just tells it to slice up a single cycle of `"bd sn"`. The `2` tells it to select two values each cycle, just like the first argument to `fit`.  The next pattern `"0 1"` is the "from" pattern which tells it how to slice, which in this case means `"0"` maps to `"bd"`, and `"1"` maps to `"sn"`.  The next pattern `"1 0"` is the "to" pattern, which tells it how to rearrange those slices.  So the final result is the pattern `"sn bd"`.

A more useful example might be something like

@
d1 $ fit' 1 4 (run 4) "[0 3*2 2 1 0 3*2 2 [1*8 ~]]/2" $ chop 4 $ (sound "breaks152" # unit "c")
@

which uses `chop` to break a single sample into individual pieces, which `fit'` then puts into a list (using the `run 4` pattern) and reassembles according to the complicated integer pattern.

-}
fit' :: Pattern Time -> Int -> Pattern Int -> Pattern Int -> Pattern a -> Pattern a
fit' :: forall a.
Pattern Time
-> Int -> Pattern Int -> Pattern Int -> Pattern a -> Pattern a
fit' Pattern Time
cyc Int
n Pattern Int
from Pattern Int
to Pattern a
p = forall a. Pattern (Pattern a) -> Pattern a
squeezeJoin forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> Pattern Int -> Pattern a
_fit Int
n [Pattern a]
mapMasks Pattern Int
to
  where mapMasks :: [Pattern a]
mapMasks = [forall a. Pattern a -> Pattern a
stretch forall a b. (a -> b) -> a -> b
$ forall a. Pattern Bool -> Pattern a -> Pattern a
mask (forall a b. a -> b -> a
const Bool
True forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (a -> Bool) -> Pattern a -> Pattern a
filterValues (forall a. Eq a => a -> a -> Bool
== Int
i) Pattern Int
from') Pattern a
p'
                     | Int
i <- [Int
0..Int
nforall a. Num a => a -> a -> a
-Int
1]]
        p' :: Pattern a
p' = forall a. Pattern Time -> Pattern a -> Pattern a
density Pattern Time
cyc Pattern a
p
        from' :: Pattern Int
from' = forall a. Pattern Time -> Pattern a -> Pattern a
density Pattern Time
cyc Pattern Int
from

{-|
  Treats the given pattern @p@ as having @n@ chunks, and applies the function @f@ to one of those sections per cycle.
  Running:
   - from left to right if chunk number is positive
   - from right to left if chunk number is negative

  @
  d1 $ chunk 4 (fast 4) $ sound "cp sn arpy [mt lt]"
  @
-}
chunk :: Pattern Int -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b
chunk :: forall b.
Pattern Int -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b
chunk Pattern Int
npat Pattern b -> Pattern b
f Pattern b
p = forall a. Pattern (Pattern a) -> Pattern a
innerJoin forall a b. (a -> b) -> a -> b
$ (\Int
n -> forall a b.
Integral a =>
a -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b
_chunk Int
n Pattern b -> Pattern b
f Pattern b
p) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Int
npat

_chunk :: Integral a => a -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b
_chunk :: forall a b.
Integral a =>
a -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b
_chunk a
n Pattern b -> Pattern b
f Pattern b
p | a
n forall a. Ord a => a -> a -> Bool
>= a
0 = forall a. [Pattern a] -> Pattern a
cat [forall a. Arc -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
withinArc (forall a. a -> a -> ArcF a
Arc (Integer
i forall a. Integral a => a -> a -> Ratio a
% forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n) ((Integer
iforall a. Num a => a -> a -> a
+Integer
1) forall a. Integral a => a -> a -> Ratio a
% forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n)) Pattern b -> Pattern b
f Pattern b
p | Integer
i <- [Integer
0 .. forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n forall a. Num a => a -> a -> a
- Integer
1]]
             | Bool
otherwise = do Integer
i <- forall a. Time -> Pattern a -> Pattern a
_slow (forall a. Real a => a -> Time
toRational (-a
n)) forall a b. (a -> b) -> a -> b
$ forall a. Pattern a -> Pattern a
rev forall a b. (a -> b) -> a -> b
$ forall a. (Enum a, Num a) => Pattern a -> Pattern a
run (forall a b. (Integral a, Num b) => a -> b
fromIntegral (-a
n))
                              forall a. Arc -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
withinArc (forall a. a -> a -> ArcF a
Arc (Integer
i forall a. Integral a => a -> a -> Ratio a
% forall a b. (Integral a, Num b) => a -> b
fromIntegral (-a
n)) ((Integer
iforall a. Num a => a -> a -> a
+Integer
1) forall a. Integral a => a -> a -> Ratio a
% forall a b. (Integral a, Num b) => a -> b
fromIntegral (-a
n))) Pattern b -> Pattern b
f Pattern b
p

-- | DEPRECATED, use 'chunk' with negative numbers instead
chunk' :: Integral a1 => Pattern a1 -> (Pattern a2 -> Pattern a2) -> Pattern a2 -> Pattern a2
chunk' :: forall a1 a2.
Integral a1 =>
Pattern a1
-> (Pattern a2 -> Pattern a2) -> Pattern a2 -> Pattern a2
chunk' Pattern a1
npat Pattern a2 -> Pattern a2
f Pattern a2
p = forall a. Pattern (Pattern a) -> Pattern a
innerJoin forall a b. (a -> b) -> a -> b
$ (\a1
n -> forall a b.
Integral a =>
a -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b
_chunk' a1
n Pattern a2 -> Pattern a2
f Pattern a2
p) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a1
npat

-- | DEPRECATED, use '_chunk' with negative numbers instead
_chunk' :: Integral a => a -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b
_chunk' :: forall a b.
Integral a =>
a -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b
_chunk' a
n Pattern b -> Pattern b
f Pattern b
p = forall a b.
Integral a =>
a -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b
_chunk (-a
n) Pattern b -> Pattern b
f Pattern b
p

_inside :: Time -> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
_inside :: forall a1 a.
Time -> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
_inside Time
n Pattern a1 -> Pattern a
f Pattern a1
p = forall a. Time -> Pattern a -> Pattern a
_fast Time
n forall a b. (a -> b) -> a -> b
$ Pattern a1 -> Pattern a
f (forall a. Time -> Pattern a -> Pattern a
_slow Time
n Pattern a1
p)

inside :: Pattern Time -> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
inside :: forall a1 a.
Pattern Time
-> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
inside Pattern Time
np Pattern a1 -> Pattern a
f Pattern a1
p = forall a. Pattern (Pattern a) -> Pattern a
innerJoin forall a b. (a -> b) -> a -> b
$ (\Time
n -> forall a1 a.
Time -> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
_inside Time
n Pattern a1 -> Pattern a
f Pattern a1
p) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Time
np

_outside :: Time -> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
_outside :: forall a1 a.
Time -> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
_outside Time
n = forall a1 a.
Time -> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
_inside (Time
1forall a. Fractional a => a -> a -> a
/Time
n)

outside :: Pattern Time -> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
outside :: forall a1 a.
Pattern Time
-> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
outside Pattern Time
np Pattern a1 -> Pattern a
f Pattern a1
p = forall a. Pattern (Pattern a) -> Pattern a
innerJoin forall a b. (a -> b) -> a -> b
$ (\Time
n -> forall a1 a.
Time -> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
_outside Time
n Pattern a1 -> Pattern a
f Pattern a1
p) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Time
np

loopFirst :: Pattern a -> Pattern a
loopFirst :: forall a. Pattern a -> Pattern a
loopFirst Pattern a
p = forall a. Pattern a -> Pattern a
splitQueries forall a b. (a -> b) -> a -> b
$ Pattern a
p {query :: State -> [Event a]
query = State -> [Event a]
f}
  where f :: State -> [Event a]
f State
st = forall a b. (a -> b) -> [a] -> [b]
map
          (\(Event Context
c Maybe Arc
w Arc
p' a
v) ->
             forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event Context
c (Arc -> Arc
plus forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Arc
w) (Arc -> Arc
plus Arc
p') a
v) forall a b. (a -> b) -> a -> b
$
          forall a. Pattern a -> State -> [Event a]
query Pattern a
p (State
st {arc :: Arc
arc = Arc -> Arc
minus forall a b. (a -> b) -> a -> b
$ State -> Arc
arc State
st})
          where minus :: Arc -> Arc
minus = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Num a => a -> a -> a
subtract (Time -> Time
sam Time
s))
                plus :: Arc -> Arc
plus = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Num a => a -> a -> a
+ Time -> Time
sam Time
s)
                s :: Time
s = forall a. ArcF a -> a
start forall a b. (a -> b) -> a -> b
$ State -> Arc
arc State
st

timeLoop :: Pattern Time -> Pattern a -> Pattern a
timeLoop :: forall a. Pattern Time -> Pattern a -> Pattern a
timeLoop Pattern Time
n = forall a1 a.
Pattern Time
-> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
outside Pattern Time
n forall a. Pattern a -> Pattern a
loopFirst

seqPLoop :: [(Time, Time, Pattern a)] -> Pattern a
seqPLoop :: forall a. [(Time, Time, Pattern a)] -> Pattern a
seqPLoop [(Time, Time, Pattern a)]
ps = forall a. Pattern Time -> Pattern a -> Pattern a
timeLoop (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Time
maxT forall a. Num a => a -> a -> a
- Time
minT) forall a b. (a -> b) -> a -> b
$ Time
minT forall a. Time -> Pattern a -> Pattern a
`rotL` forall a. [(Time, Time, Pattern a)] -> Pattern a
seqP [(Time, Time, Pattern a)]
ps
  where minT :: Time
minT = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(Time
x,Time
_,Pattern a
_) -> Time
x) [(Time, Time, Pattern a)]
ps
        maxT :: Time
maxT = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(Time
_,Time
x,Pattern a
_) -> Time
x) [(Time, Time, Pattern a)]
ps

{- | @toScale@ lets you turn a pattern of notes within a scale (expressed as a
list) to note numbers.  For example `toScale [0, 4, 7] "0 1 2 3"` will turn
into the pattern `"0 4 7 12"`.  It assumes your scale fits within an octave;
to change this use `toScale' size`.  Example:
`toScale' 24 [0,4,7,10,14,17] (run 8)` turns into `"0 4 7 10 14 17 24 28"`
-}
toScale' :: Num a => Int -> [a] -> Pattern Int -> Pattern a
toScale' :: forall a. Num a => Int -> [a] -> Pattern Int -> Pattern a
toScale' Int
_ [] = forall a b. a -> b -> a
const forall a. Pattern a
silence
toScale' Int
o [a]
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> a
noteInScale
  where octave :: Int -> Int
octave Int
x = Int
x forall a. Integral a => a -> a -> a
`div` forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
s
        noteInScale :: Int -> a
noteInScale Int
x = ([a]
s forall a. [a] -> Int -> a
!!! Int
x) forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
o forall a. Num a => a -> a -> a
* Int -> Int
octave Int
x)

toScale :: Num a => [a] -> Pattern Int -> Pattern a
toScale :: forall a. Num a => [a] -> Pattern Int -> Pattern a
toScale = forall a. Num a => Int -> [a] -> Pattern Int -> Pattern a
toScale' Int
12

{- | `swingBy x n` divides a cycle into `n` slices and delays the notes in
the second half of each slice by `x` fraction of a slice . @swing@ is an alias
for `swingBy (1%3)`
-}
swingBy :: Pattern Time -> Pattern Time -> Pattern a -> Pattern a
swingBy :: forall a. Pattern Time -> Pattern Time -> Pattern a -> Pattern a
swingBy Pattern Time
x Pattern Time
n = forall a1 a.
Pattern Time
-> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
inside Pattern Time
n (forall a. Arc -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
withinArc (forall a. a -> a -> ArcF a
Arc Time
0.5 Time
1) (Pattern Time
x forall a. Pattern Time -> Pattern a -> Pattern a
~>))

swing :: Pattern Time -> Pattern a -> Pattern a
swing :: forall a. Pattern Time -> Pattern a -> Pattern a
swing = forall a. Pattern Time -> Pattern Time -> Pattern a -> Pattern a
swingBy (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Integer
1forall a. Integral a => a -> a -> Ratio a
%Integer
3)

{- | `cycleChoose` is like `choose` but only picks a new item from the list
once each cycle -}
cycleChoose :: [a] -> Pattern a
cycleChoose :: forall a. [a] -> Pattern a
cycleChoose = forall a. Pattern Time -> Pattern a -> Pattern a
segment Pattern Time
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Pattern a
choose

{- | Internal function used by shuffle and scramble -}
_rearrangeWith :: Pattern Int -> Int -> Pattern a -> Pattern a
_rearrangeWith :: forall a. Pattern Int -> Int -> Pattern a -> Pattern a
_rearrangeWith Pattern Int
ipat Int
n Pattern a
pat = forall a. Pattern (Pattern a) -> Pattern a
innerJoin forall a b. (a -> b) -> a -> b
$ (\Int
i -> forall a. Time -> Pattern a -> Pattern a
_fast Time
nT forall a b. (a -> b) -> a -> b
$ forall a. Int -> Pattern a -> Pattern a
_repeatCycles Int
n forall a b. (a -> b) -> a -> b
$ [Pattern a]
pats forall a. [a] -> Int -> a
!! Int
i) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Int
ipat
  where
    pats :: [Pattern a]
pats = forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> forall a. (Time, Time) -> Pattern a -> Pattern a
zoom (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i forall a. Fractional a => a -> a -> a
/ Time
nT, forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
iforall a. Num a => a -> a -> a
+Int
1) forall a. Fractional a => a -> a -> a
/ Time
nT) Pattern a
pat) [Int
0 .. (Int
nforall a. Num a => a -> a -> a
-Int
1)]
    nT :: Time
    nT :: Time
nT = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n

{- | `shuffle n p` evenly divides one cycle of the pattern `p` into `n` parts,
and returns a random permutation of the parts each cycle.  For example,
`shuffle 3 "a b c"` could return `"a b c"`, `"a c b"`, `"b a c"`, `"b c a"`,
`"c a b"`, or `"c b a"`.  But it will **never** return `"a a a"`, because that
is not a permutation of the parts.
-}
shuffle :: Pattern Int -> Pattern a -> Pattern a
shuffle :: forall c. Pattern Int -> Pattern c -> Pattern c
shuffle = forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam forall a. Int -> Pattern a -> Pattern a
_shuffle

_shuffle :: Int -> Pattern a -> Pattern a
_shuffle :: forall a. Int -> Pattern a -> Pattern a
_shuffle Int
n = forall a. Pattern Int -> Int -> Pattern a -> Pattern a
_rearrangeWith (Int -> Pattern Int
randrun Int
n) Int
n

{- | `scramble n p` is like `shuffle` but randomly selects from the parts
of `p` instead of making permutations.
For example, `scramble 3 "a b c"` will randomly select 3 parts from
`"a"` `"b"` and `"c"`, possibly repeating a single part.
-}
scramble :: Pattern Int -> Pattern a -> Pattern a
scramble :: forall c. Pattern Int -> Pattern c -> Pattern c
scramble = forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam forall a. Int -> Pattern a -> Pattern a
_scramble

_scramble :: Int -> Pattern a -> Pattern a
_scramble :: forall a. Int -> Pattern a -> Pattern a
_scramble Int
n = forall a. Pattern Int -> Int -> Pattern a -> Pattern a
_rearrangeWith (forall a. Time -> Pattern a -> Pattern a
_segment (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) forall a b. (a -> b) -> a -> b
$ forall a. Num a => Int -> Pattern a
_irand Int
n) Int
n

randrun :: Int -> Pattern Int
randrun :: Int -> Pattern Int
randrun Int
0 = forall a. Pattern a
silence
randrun Int
n' =
  forall a. Pattern a -> Pattern a
splitQueries forall a b. (a -> b) -> a -> b
$ forall a. (State -> [Event a]) -> Pattern a
Pattern (\(State a :: Arc
a@(Arc Time
s Time
_) ValueMap
_) -> forall {p}. RealFrac p => Arc -> p -> [Event Int]
events Arc
a forall a b. (a -> b) -> a -> b
$ Time -> Time
sam Time
s)
  where events :: Arc -> p -> [Event Int]
events Arc
a p
seed = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {b}. (Arc, b) -> Maybe (EventF Arc b)
toEv forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Arc]
arcs [Int]
shuffled
          where shuffled :: [Int]
shuffled = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Double]
rs [Int
0 .. (Int
n'forall a. Num a => a -> a -> a
-Int
1)]
                rs :: [Double]
rs = forall a b. (RealFrac a, Fractional b) => a -> Int -> [b]
timeToRands p
seed Int
n' :: [Double]
                arcs :: [Arc]
arcs = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. a -> a -> ArcF a
Arc [Time]
fractions (forall a. [a] -> [a]
tail [Time]
fractions)
                fractions :: [Time]
fractions = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Num a => a -> a -> a
+ (Time -> Time
sam forall a b. (a -> b) -> a -> b
$ forall a. ArcF a -> a
start Arc
a)) [Time
0, Time
1 forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n' .. Time
1]
                toEv :: (Arc, b) -> Maybe (EventF Arc b)
toEv (Arc
a',b
v) = do Arc
a'' <- Arc -> Arc -> Maybe Arc
subArc Arc
a Arc
a'
                                 forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event ([((Int, Int), (Int, Int))] -> Context
Context []) (forall a. a -> Maybe a
Just Arc
a') Arc
a'' b
v


ur :: Time -> Pattern String -> [(String, Pattern a)] -> [(String, Pattern a -> Pattern a)] -> Pattern a
ur :: forall a.
Time
-> Pattern [Char]
-> [([Char], Pattern a)]
-> [([Char], Pattern a -> Pattern a)]
-> Pattern a
ur Time
t Pattern [Char]
outer_p [([Char], Pattern a)]
ps [([Char], Pattern a -> Pattern a)]
fs = forall a. Time -> Pattern a -> Pattern a
_slow Time
t forall a b. (a -> b) -> a -> b
$ forall a. Pattern (Pattern a) -> Pattern a
unwrap forall a b. (a -> b) -> a -> b
$ forall {t} {t} {t}. (t, (t, t -> t -> t)) -> t
adjust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {b}. Pattern b -> Pattern (Arc, b)
timedValues ([[Char]] -> (Pattern a, Arc -> Pattern a -> Pattern a)
getPat forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
split forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern [Char]
outer_p)
  where split :: [Char] -> [[Char]]
split = forall a. (a -> Bool) -> [a] -> [[a]]
wordsBy (forall a. Eq a => a -> a -> Bool
==Char
':')
        getPat :: [[Char]] -> (Pattern a, Arc -> Pattern a -> Pattern a)
getPat ([Char]
s:[[Char]]
xs) = ([Char] -> Pattern a
match [Char]
s, [[Char]] -> Arc -> Pattern a -> Pattern a
transform [[Char]]
xs)
        -- TODO - check this really can't happen..
        getPat [[Char]]
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"can't happen?"
        match :: [Char] -> Pattern a
match [Char]
s = forall a. a -> Maybe a -> a
fromMaybe forall a. Pattern a
silence forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
s [([Char], Pattern a)]
ps'
        ps' :: [([Char], Pattern a)]
ps' = forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Time -> Pattern a -> Pattern a
_fast Time
t)) [([Char], Pattern a)]
ps
        adjust :: (t, (t, t -> t -> t)) -> t
adjust (t
a, (t
p, t -> t -> t
f)) = t -> t -> t
f t
a t
p
        transform :: [[Char]] -> Arc -> Pattern a -> Pattern a
transform ([Char]
x:[[Char]]
_) Arc
a = [Char] -> Arc -> Pattern a -> Pattern a
transform' [Char]
x Arc
a
        transform [[Char]]
_ Arc
_ = forall a. a -> a
id
        transform' :: [Char] -> Arc -> Pattern a -> Pattern a
transform' [Char]
str (Arc Time
s Time
e) Pattern a
p = Time
s forall a. Time -> Pattern a -> Pattern a
`rotR` forall a1 a.
Pattern Time
-> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
inside (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Time
1forall a. Fractional a => a -> a -> a
/(Time
eforall a. Num a => a -> a -> a
-Time
s)) ([Char] -> Pattern a -> Pattern a
matchF [Char]
str) Pattern a
p
        matchF :: [Char] -> Pattern a -> Pattern a
matchF [Char]
str = forall a. a -> Maybe a -> a
fromMaybe forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
str [([Char], Pattern a -> Pattern a)]
fs
        timedValues :: Pattern b -> Pattern (Arc, b)
timedValues = forall a b. (Event a -> Event b) -> Pattern a -> Pattern b
withEvent (\(Event Context
c (Just Arc
a) Arc
a' b
v) -> forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event Context
c (forall a. a -> Maybe a
Just Arc
a) Arc
a' (Arc
a,b
v)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pattern a -> Pattern a
filterDigital

inhabit :: [(String, Pattern a)] -> Pattern String -> Pattern a
inhabit :: forall a. [([Char], Pattern a)] -> Pattern [Char] -> Pattern a
inhabit [([Char], Pattern a)]
ps Pattern [Char]
p = forall a. Pattern (Pattern a) -> Pattern a
squeezeJoin forall a b. (a -> b) -> a -> b
$ (\[Char]
s -> forall a. a -> Maybe a -> a
fromMaybe forall a. Pattern a
silence forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
s [([Char], Pattern a)]
ps) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern [Char]
p

{- | @spaceOut xs p@ repeats a pattern @p@ at different durations given by the list of time values in @xs@ -}
spaceOut :: [Time] -> Pattern a -> Pattern a
spaceOut :: forall a. [Time] -> Pattern a -> Pattern a
spaceOut [Time]
xs Pattern a
p = forall a. Time -> Pattern a -> Pattern a
_slow (forall a. Real a => a -> Time
toRational forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Time]
xs) forall a b. (a -> b) -> a -> b
$ forall a. [Pattern a] -> Pattern a
stack forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. Arc -> Pattern a -> Pattern a
`compressArc` Pattern a
p) [Arc]
spaceArcs
  where markOut :: Time -> [Time] -> [Arc]
        markOut :: Time -> [Time] -> [Arc]
markOut Time
_ [] = []
        markOut Time
offset (Time
x:[Time]
xs') = forall a. a -> a -> ArcF a
Arc Time
offset (Time
offsetforall a. Num a => a -> a -> a
+Time
x)forall a. a -> [a] -> [a]
:Time -> [Time] -> [Arc]
markOut (Time
offsetforall a. Num a => a -> a -> a
+Time
x) [Time]
xs'
        spaceArcs :: [Arc]
spaceArcs = forall a b. (a -> b) -> [a] -> [b]
map (\(Arc Time
a Time
b) -> forall a. a -> a -> ArcF a
Arc (Time
aforall a. Fractional a => a -> a -> a
/Time
s) (Time
bforall a. Fractional a => a -> a -> a
/Time
s)) forall a b. (a -> b) -> a -> b
$ Time -> [Time] -> [Arc]
markOut Time
0 [Time]
xs
        s :: Time
s = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Time]
xs

-- | @flatpat@ takes a Pattern of lists and pulls the list elements as
-- separate Events
flatpat :: Pattern [a] -> Pattern a
flatpat :: forall a. Pattern [a] -> Pattern a
flatpat Pattern [a]
p = Pattern [a]
p {query :: State -> [Event a]
query = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Event Context
c Maybe Arc
b Arc
b' [a]
xs) -> forall a b. (a -> b) -> [a] -> [b]
map (forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event Context
c Maybe Arc
b Arc
b') [a]
xs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pattern a -> State -> [Event a]
query Pattern [a]
p}

-- | @layer@ takes a Pattern of lists and pulls the list elements as
-- separate Events
layer :: [a -> Pattern b] -> a -> Pattern b
layer :: forall a b. [a -> Pattern b] -> a -> Pattern b
layer [a -> Pattern b]
fs a
p = forall a. [Pattern a] -> Pattern a
stack forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> a -> b
$ a
p) [a -> Pattern b]
fs

-- | @arpeggiate@ finds events that share the same timespan, and spreads
-- them out during that timespan, so for example @arpeggiate "[bd,sn]"@
-- gets turned into @"bd sn"@. Useful for creating arpeggios/broken chords.
arpeggiate :: Pattern a -> Pattern a
arpeggiate :: forall a. Pattern a -> Pattern a
arpeggiate = forall a b.
([EventF Arc a] -> [EventF Arc b]) -> Pattern a -> Pattern b
arpWith forall a. a -> a
id

-- | Shorthand alias for arpeggiate
arpg :: Pattern a -> Pattern a
arpg :: forall a. Pattern a -> Pattern a
arpg = forall a. Pattern a -> Pattern a
arpeggiate

arpWith :: ([EventF (ArcF Time) a] -> [EventF (ArcF Time) b]) -> Pattern a -> Pattern b
arpWith :: forall a b.
([EventF Arc a] -> [EventF Arc b]) -> Pattern a -> Pattern b
arpWith [EventF Arc a] -> [EventF Arc b]
f Pattern a
p = forall a b.
([EventF Arc a] -> [EventF Arc b]) -> Pattern a -> Pattern b
withEvents [EventF Arc a] -> [EventF Arc b]
munge Pattern a
p
  where munge :: [EventF Arc a] -> [EventF Arc b]
munge [EventF Arc a]
es = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall {b}. [EventF Arc b] -> [EventF Arc b]
spreadOut forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EventF Arc a] -> [EventF Arc b]
f) (forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\EventF Arc a
a EventF Arc a
b -> forall a b. EventF a b -> Maybe a
whole EventF Arc a
a forall a. Eq a => a -> a -> Bool
== forall a b. EventF a b -> Maybe a
whole EventF Arc a
b) forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a b. EventF a b -> Maybe a
whole [EventF Arc a]
es)
        spreadOut :: [EventF Arc b] -> [EventF Arc b]
spreadOut [EventF Arc b]
xs = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(Int
n, EventF Arc b
x) -> forall {p} {p} {b}.
(Integral p, Integral p) =>
p -> p -> EventF Arc b -> Maybe (EventF Arc b)
shiftIt Int
n (forall (t :: * -> *) a. Foldable t => t a -> Int
length [EventF Arc b]
xs) EventF Arc b
x) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [(Int, a)]
enumerate [EventF Arc b]
xs
        shiftIt :: p -> p -> EventF Arc b -> Maybe (EventF Arc b)
shiftIt p
n p
d (Event Context
c (Just (Arc Time
s Time
e)) Arc
a' b
v) =
          do
            Arc
a'' <- Arc -> Arc -> Maybe Arc
subArc (forall a. a -> a -> ArcF a
Arc Time
newS Time
newE) Arc
a'
            forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event Context
c (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> ArcF a
Arc Time
newS Time
newE) Arc
a'' b
v)
          where newS :: Time
newS = Time
s forall a. Num a => a -> a -> a
+ (Time
dur forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral p
n)
                newE :: Time
newE = Time
newS forall a. Num a => a -> a -> a
+ Time
dur
                dur :: Time
dur = (Time
e forall a. Num a => a -> a -> a
- Time
s) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral p
d
        -- TODO ignoring analog events.. Should we just leave them as-is?
        shiftIt p
_ p
_ EventF Arc b
_ = forall a. Maybe a
Nothing

arp :: Pattern String -> Pattern a -> Pattern a
arp :: forall a. Pattern [Char] -> Pattern a -> Pattern a
arp = forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam forall a. [Char] -> Pattern a -> Pattern a
_arp

_arp :: String -> Pattern a -> Pattern a
_arp :: forall a. [Char] -> Pattern a -> Pattern a
_arp [Char]
name Pattern a
p = forall a b.
([EventF Arc a] -> [EventF Arc b]) -> Pattern a -> Pattern b
arpWith forall a. [a] -> [a]
f Pattern a
p
  where f :: [a] -> [a]
f = forall a. a -> Maybe a -> a
fromMaybe forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
name forall a. [([Char], [a] -> [a])]
arps
        arps :: [(String, [a] -> [a])]
        arps :: forall a. [([Char], [a] -> [a])]
arps = [([Char]
"up", forall a. a -> a
id),
                ([Char]
"down", forall a. [a] -> [a]
reverse),
                ([Char]
"updown", \[a]
x -> forall a. [a] -> [a]
init [a]
x forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [a]
init (forall a. [a] -> [a]
reverse [a]
x)),
                ([Char]
"downup", \[a]
x -> forall a. [a] -> [a]
init (forall a. [a] -> [a]
reverse [a]
x) forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [a]
init [a]
x),
                ([Char]
"up&down", \[a]
x -> [a]
x forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [a]
reverse [a]
x),
                ([Char]
"down&up", \[a]
x -> forall a. [a] -> [a]
reverse [a]
x forall a. [a] -> [a] -> [a]
++ [a]
x),
                ([Char]
"converge", forall a. [a] -> [a]
converge),
                ([Char]
"diverge", forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
converge),
                ([Char]
"disconverge", \[a]
x -> forall a. [a] -> [a]
converge [a]
x forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [a]
tail (forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
converge [a]
x)),
                ([Char]
"pinkyup", forall a. [a] -> [a]
pinkyup),
                ([Char]
"pinkyupdown", \[a]
x -> forall a. [a] -> [a]
init (forall a. [a] -> [a]
pinkyup [a]
x) forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [a]
init (forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
pinkyup [a]
x)),
                ([Char]
"thumbup", forall a. [a] -> [a]
thumbup),
                ([Char]
"thumbupdown", \[a]
x -> forall a. [a] -> [a]
init (forall a. [a] -> [a]
thumbup [a]
x) forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [a]
init (forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
thumbup [a]
x))
               ]
        converge :: [a] -> [a]
converge [] = []
        converge (a
x:[a]
xs) = a
x forall a. a -> [a] -> [a]
: [a] -> [a]
converge' [a]
xs
        converge' :: [a] -> [a]
converge' [] = []
        converge' [a]
xs = forall a. [a] -> a
last [a]
xs forall a. a -> [a] -> [a]
: [a] -> [a]
converge (forall a. [a] -> [a]
init [a]
xs)
        pinkyup :: [b] -> [b]
pinkyup [b]
xs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. a -> [a] -> [a]
:[b
pinky]) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
init [b]
xs
          where pinky :: b
pinky = forall a. [a] -> a
last [b]
xs
        thumbup :: [b] -> [b]
thumbup [b]
xs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\b
x -> [b
thumb,b
x]) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
tail [b]
xs
          where thumb :: b
thumb = forall a. [a] -> a
head [b]
xs

{- | `rolled` plays each note of a chord quickly in order, as opposed to simultaneously; to give a chord a harp-like effect.
This will played from the lowest note to the highest note of the chord
@
rolled $ n "c'maj'4" # s "superpiano"
@


And you can use `rolledBy` or `rolledBy'` to specify the length of the roll. The value in the passed pattern
is the divisor of the cycle length. A negative value will play the arpeggio in reverse order.

@
rolledBy "<1 -0.5 0.25 -0.125>" $ note "c'maj9" # s "superpiano"
@
-}

rolledWith :: Ratio Integer -> Pattern a -> Pattern a
rolledWith :: forall a. Time -> Pattern a -> Pattern a
rolledWith Time
t = forall a b.
([EventF Arc a] -> [EventF Arc b]) -> Pattern a -> Pattern b
withEvents forall {b}. [EventF Arc b] -> [EventF Arc b]
aux
         where aux :: [EventF Arc b] -> [EventF Arc b]
aux [EventF Arc b]
es = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall {b}. [EventF Arc b] -> [EventF Arc b]
steppityIn) (forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\EventF Arc b
a EventF Arc b
b -> forall a b. EventF a b -> Maybe a
whole EventF Arc b
a forall a. Eq a => a -> a -> Bool
== forall a b. EventF a b -> Maybe a
whole EventF Arc b
b) forall a b. (a -> b) -> a -> b
$ ((forall {a} {a}. (Ord a, Num a) => a -> [a] -> [a]
isRev Time
t) [EventF Arc b]
es))
               isRev :: a -> [a] -> [a]
isRev a
b = (\a
x -> if a
x forall a. Ord a => a -> a -> Bool
> a
0 then forall a. a -> a
id else forall a. [a] -> [a]
reverse ) a
b
               steppityIn :: [EventF Arc b] -> [EventF Arc b]
steppityIn [EventF Arc b]
xs = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(Int
n, EventF Arc b
ev) -> (forall {p} {t :: * -> *} {a} {a} {b}.
(Integral p, Foldable t, Num a, Eq a) =>
p -> t a -> EventF Arc b -> a -> Maybe (EventF Arc b)
timeguard Int
n [EventF Arc b]
xs EventF Arc b
ev Time
t)) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [(Int, a)]
enumerate [EventF Arc b]
xs
               timeguard :: p -> t a -> EventF Arc b -> a -> Maybe (EventF Arc b)
timeguard p
_ t a
_ EventF Arc b
ev a
0 = forall (m :: * -> *) a. Monad m => a -> m a
return EventF Arc b
ev
               timeguard p
n t a
xs EventF Arc b
ev a
_ = (forall {p} {p} {b}.
(Integral p, Integral p) =>
p -> p -> EventF Arc b -> Maybe (EventF Arc b)
shiftIt p
n (forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
xs) EventF Arc b
ev)
               shiftIt :: p -> p -> EventF Arc b -> Maybe (EventF Arc b)
shiftIt p
n p
d (Event Context
c (Just (Arc Time
s Time
e)) Arc
a' b
v) = do
                         Arc
a'' <- Arc -> Arc -> Maybe Arc
subArc (forall a. a -> a -> ArcF a
Arc Time
newS Time
e) Arc
a'
                         forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event Context
c (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> ArcF a
Arc Time
newS Time
e) Arc
a'' b
v)
                      where newS :: Time
newS = Time
s forall a. Num a => a -> a -> a
+ (Time
dur forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral p
n)
                            dur :: Time
dur = ((Time
e forall a. Num a => a -> a -> a
- Time
s)) forall a. Fractional a => a -> a -> a
/ ((Time
1forall a. Fractional a => a -> a -> a
/ (forall a. Num a => a -> a
abs Time
t))forall a. Num a => a -> a -> a
*forall a b. (Integral a, Num b) => a -> b
fromIntegral p
d)
               shiftIt p
_ p
_ EventF Arc b
ev =  forall (m :: * -> *) a. Monad m => a -> m a
return EventF Arc b
ev

rolledBy :: Pattern (Ratio Integer) -> Pattern a -> Pattern a
rolledBy :: forall a. Pattern Time -> Pattern a -> Pattern a
rolledBy Pattern Time
pt = forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam forall a. Time -> Pattern a -> Pattern a
rolledWith (forall a. Pattern Time -> Pattern a -> Pattern a
segment Pattern Time
1 forall a b. (a -> b) -> a -> b
$ Pattern Time
pt)

rolled :: Pattern a -> Pattern a
rolled :: forall a. Pattern a -> Pattern a
rolled = forall a. Pattern Time -> Pattern a -> Pattern a
rolledBy (Pattern Time
1forall a. Fractional a => a -> a -> a
/Pattern Time
4)

{- TODO !

-- | @fill@ 'fills in' gaps in one pattern with events from another. For example @fill "bd" "cp ~ cp"@ would result in the equivalent of `"~ bd ~"`. This only finds gaps in a resulting pattern, in other words @"[bd ~, sn]"@ doesn't contain any gaps (because @sn@ covers it all), and @"bd ~ ~ sn"@ only contains a single gap that bridges two steps.
fill :: Pattern a -> Pattern a -> Pattern a
fill p' p = struct (splitQueries $ p {query = q}) p'
  where
    q st = removeTolerance (s,e) $ invert (s-tolerance, e+tolerance) $ query p (st {arc = (s-tolerance, e+tolerance)})
      where (s,e) = arc st
    invert (s,e) es = map arcToEvent $ foldr remove [(s,e)] (map part es)
    remove (s,e) xs = concatMap (remove' (s, e)) xs
    remove' (s,e) (s',e') | s > s' && e < e' = [(s',s),(e,e')] -- inside
                          | s > s' && s < e' = [(s',s)] -- cut off right
                          | e > s' && e < e' = [(e,e')] -- cut off left
                          | s <= s' && e >= e' = [] -- swallow
                          | otherwise = [(s',e')] -- miss
    arcToEvent a = ((a,a),"x")
    removeTolerance (s,e) es = concatMap (expand) $ map (withPart f) es
      where f a = concatMap (remove' (e,e+tolerance)) $ remove' (s-tolerance,s) a
            expand ((a,xs),c) = map (\x -> ((a,x),c)) xs
    tolerance = 0.01
-}

-- Repeats each event @n@ times within its arc
ply :: Pattern Rational -> Pattern a -> Pattern a
ply :: forall a. Pattern Time -> Pattern a -> Pattern a
ply = forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam forall a. Time -> Pattern a -> Pattern a
_ply

_ply :: Rational -> Pattern a -> Pattern a
_ply :: forall a. Time -> Pattern a -> Pattern a
_ply Time
n Pattern a
pat = forall a. Pattern (Pattern a) -> Pattern a
squeezeJoin forall a b. (a -> b) -> a -> b
$ (forall a. Time -> Pattern a -> Pattern a
_fast Time
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
pat

-- Like ply, but applies a function each time. The applications are compounded.
plyWith :: (Ord t, Num t) => Pattern t -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
plyWith :: forall t a.
(Ord t, Num t) =>
Pattern t -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
plyWith Pattern t
np Pattern a -> Pattern a
f Pattern a
p = forall a. Pattern (Pattern a) -> Pattern a
innerJoin forall a b. (a -> b) -> a -> b
$ (\t
n -> forall t a.
(Ord t, Num t) =>
t -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_plyWith t
n Pattern a -> Pattern a
f Pattern a
p) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern t
np

_plyWith :: (Ord t, Num t) => t -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_plyWith :: forall t a.
(Ord t, Num t) =>
t -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_plyWith t
numPat Pattern a -> Pattern a
f Pattern a
p = forall a. Pattern a -> Pattern a
arpeggiate forall a b. (a -> b) -> a -> b
$ forall {a}. (Ord a, Num a) => a -> Pattern a
compound t
numPat
  where compound :: a -> Pattern a
compound a
n | a
n forall a. Ord a => a -> a -> Bool
<= a
1 = Pattern a
p
                   | Bool
otherwise = forall a. Pattern a -> Pattern a -> Pattern a
overlay Pattern a
p (Pattern a -> Pattern a
f forall a b. (a -> b) -> a -> b
$ a -> Pattern a
compound forall a b. (a -> b) -> a -> b
$ a
nforall a. Num a => a -> a -> a
-a
1)

-- | Syncopates a rhythm, shifting each event halfway into its arc (aka timespan), e.g. @"a b [c d] e"@ becomes the equivalent of @"[~ a] [~ b] [[~ c] [~ d]] [~ e]"@
press :: Pattern a -> Pattern a
press :: forall a. Pattern a -> Pattern a
press = forall a. Time -> Pattern a -> Pattern a
_pressBy Time
0.5

-- | Like @press@, but allows you to specify the amount in which each event is shifted. @pressBy 0.5@ is the same as @press@, while @pressBy (1/3)@ shifts each event by a third of its arc.
pressBy :: Pattern Time -> Pattern a -> Pattern a
pressBy :: forall a. Pattern Time -> Pattern a -> Pattern a
pressBy = forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam forall a. Time -> Pattern a -> Pattern a
_pressBy

_pressBy :: Time -> Pattern a -> Pattern a
_pressBy :: forall a. Time -> Pattern a -> Pattern a
_pressBy Time
r Pattern a
pat = forall a. Pattern (Pattern a) -> Pattern a
squeezeJoin forall a b. (a -> b) -> a -> b
$ (forall a. (Time, Time) -> Pattern a -> Pattern a
compressTo (Time
r,Time
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
pat

-- | Uses the first (binary) pattern to switch between the following
-- two patterns. The resulting structure comes from the source patterns, not the
-- binary pattern. See also @stitch@.
sew :: Pattern Bool -> Pattern a -> Pattern a -> Pattern a
sew :: forall a. Pattern Bool -> Pattern a -> Pattern a -> Pattern a
sew Pattern Bool
pb Pattern a
a Pattern a
b = forall a. Pattern a -> Pattern a -> Pattern a
overlay (forall a. Pattern Bool -> Pattern a -> Pattern a
mask Pattern Bool
pb Pattern a
a) (forall a. Pattern Bool -> Pattern a -> Pattern a
mask (forall (f :: * -> *). Functor f => f Bool -> f Bool
inv Pattern Bool
pb) Pattern a
b)

-- | Uses the first (binary) pattern to switch between the following
-- two patterns. The resulting structure comes from the binary
-- pattern, not the source patterns. See also @sew@.
stitch :: Pattern Bool -> Pattern a -> Pattern a -> Pattern a
stitch :: forall a. Pattern Bool -> Pattern a -> Pattern a -> Pattern a
stitch Pattern Bool
pb Pattern a
a Pattern a
b = forall a. Pattern a -> Pattern a -> Pattern a
overlay (forall a. Pattern Bool -> Pattern a -> Pattern a
struct Pattern Bool
pb Pattern a
a)  (forall a. Pattern Bool -> Pattern a -> Pattern a
struct (forall (f :: * -> *). Functor f => f Bool -> f Bool
inv Pattern Bool
pb) Pattern a
b)

-- | A binary pattern is used to conditionally apply a function to a
-- source pattern. The function is applied when a @True@ value is
-- active, and the pattern is let through unchanged when a @False@
-- value is active. No events are let through where no binary values
-- are active.
while :: Pattern Bool -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
while :: forall a.
Pattern Bool -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
while Pattern Bool
b Pattern a -> Pattern a
f Pattern a
pat = forall a. Pattern Bool -> Pattern a -> Pattern a -> Pattern a
sew Pattern Bool
b (Pattern a -> Pattern a
f Pattern a
pat) Pattern a
pat

stutter :: Integral i => i -> Time -> Pattern a -> Pattern a
stutter :: forall i a. Integral i => i -> Time -> Pattern a -> Pattern a
stutter i
n Time
t Pattern a
p = forall a. [Pattern a] -> Pattern a
stack forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\i
i -> (Time
t forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral i
i) forall a. Time -> Pattern a -> Pattern a
`rotR` Pattern a
p) [i
0 .. (i
nforall a. Num a => a -> a -> a
-i
1)]

{- | The `jux` function creates strange stereo effects, by applying a
function to a pattern, but only in the right-hand channel. For
example, the following reverses the pattern on the righthand side:

@
d1 $ slow 32 $ jux (rev) $ striateBy 32 (1/16) $ sound "bev"
@

When passing pattern transforms to functions like [jux](#jux) and [every](#every),
it's possible to chain multiple transforms together with `.`, for
example this both reverses and halves the playback speed of the
pattern in the righthand channel:

@
d1 $ slow 32 $ jux ((# speed "0.5") . rev) $ striateBy 32 (1/16) $ sound "bev"
@
-}
jux
  :: (Pattern ValueMap -> Pattern ValueMap)
     -> Pattern ValueMap -> Pattern ValueMap
jux :: (Pattern ValueMap -> Pattern ValueMap)
-> Pattern ValueMap -> Pattern ValueMap
jux = Pattern Double
-> (Pattern ValueMap -> Pattern ValueMap)
-> Pattern ValueMap
-> Pattern ValueMap
juxBy Pattern Double
1
juxcut
  :: (Pattern ValueMap -> Pattern ValueMap)
     -> Pattern ValueMap -> Pattern ValueMap
juxcut :: (Pattern ValueMap -> Pattern ValueMap)
-> Pattern ValueMap -> Pattern ValueMap
juxcut Pattern ValueMap -> Pattern ValueMap
f Pattern ValueMap
p = forall a. [Pattern a] -> Pattern a
stack [Pattern ValueMap
p     forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> Pattern ValueMap
P.pan (forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
0) forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Int -> Pattern ValueMap
P.cut (forall (f :: * -> *) a. Applicative f => a -> f a
pure (-Int
1)),
                    Pattern ValueMap -> Pattern ValueMap
f forall a b. (a -> b) -> a -> b
$ Pattern ValueMap
p forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> Pattern ValueMap
P.pan (forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
1) forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Int -> Pattern ValueMap
P.cut (forall (f :: * -> *) a. Applicative f => a -> f a
pure (-Int
2))
                   ]

juxcut' :: [t -> Pattern ValueMap] -> t -> Pattern ValueMap
juxcut' :: forall t. [t -> Pattern ValueMap] -> t -> Pattern ValueMap
juxcut' [t -> Pattern ValueMap]
fs t
p = forall a. [Pattern a] -> Pattern a
stack forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Int
n -> (([t -> Pattern ValueMap]
fs forall a. [a] -> Int -> a
!! Int
n) t
p forall a. Num a => Pattern a -> Pattern a -> Pattern a
|+ Pattern Int -> Pattern ValueMap
P.cut (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int
1forall a. Num a => a -> a -> a
-Int
n)) forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> Pattern ValueMap
P.pan (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)) [Int
0 .. Int
lforall a. Num a => a -> a -> a
-Int
1]
  where l :: Int
l = forall (t :: * -> *) a. Foldable t => t a -> Int
length [t -> Pattern ValueMap]
fs

{- | In addition to `jux`, `jux'` allows using a list of pattern transform. resulting patterns from each transformation will be spread via pan from left to right.

For example:

@
d1 $ jux' [iter 4, chop 16, id, rev, palindrome] $ sound "bd sn"
@

will put `iter 4` of the pattern to the far left and `palindrome` to the far right. In the center the original pattern will play and mid left mid right the chopped and the reversed version will appear.

One could also write:

@
d1 $ stack [
    iter 4 $ sound "bd sn" # pan "0",
    chop 16 $ sound "bd sn" # pan "0.25",
    sound "bd sn" # pan "0.5",
    rev $ sound "bd sn" # pan "0.75",
    palindrome $ sound "bd sn" # pan "1",
    ]
@

-}
jux' :: [t -> Pattern ValueMap] -> t -> Pattern ValueMap
jux' :: forall t. [t -> Pattern ValueMap] -> t -> Pattern ValueMap
jux' [t -> Pattern ValueMap]
fs t
p = forall a. [Pattern a] -> Pattern a
stack forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Int
n -> ([t -> Pattern ValueMap]
fs forall a. [a] -> Int -> a
!! Int
n) t
p forall a. Num a => Pattern a -> Pattern a -> Pattern a
|+ Pattern Double -> Pattern ValueMap
P.pan (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)) [Int
0 .. Int
lforall a. Num a => a -> a -> a
-Int
1]
  where l :: Int
l = forall (t :: * -> *) a. Foldable t => t a -> Int
length [t -> Pattern ValueMap]
fs

-- | Multichannel variant of `jux`, _not sure what it does_
jux4
  :: (Pattern ValueMap -> Pattern ValueMap)
     -> Pattern ValueMap -> Pattern ValueMap
jux4 :: (Pattern ValueMap -> Pattern ValueMap)
-> Pattern ValueMap -> Pattern ValueMap
jux4 Pattern ValueMap -> Pattern ValueMap
f Pattern ValueMap
p = forall a. [Pattern a] -> Pattern a
stack [Pattern ValueMap
p forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> Pattern ValueMap
P.pan (forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double
5forall a. Fractional a => a -> a -> a
/Double
8)), Pattern ValueMap -> Pattern ValueMap
f forall a b. (a -> b) -> a -> b
$ Pattern ValueMap
p forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> Pattern ValueMap
P.pan (forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double
1forall a. Fractional a => a -> a -> a
/Double
8))]

{- |
With `jux`, the original and effected versions of the pattern are
panned hard left and right (i.e., panned at 0 and 1). This can be a
bit much, especially when listening on headphones. The variant `juxBy`
has an additional parameter, which brings the channel closer to the
centre. For example:

@
d1 $ juxBy 0.5 (density 2) $ sound "bd sn:1"
@

In the above, the two versions of the pattern would be panned at 0.25
and 0.75, rather than 0 and 1.
-}
juxBy
  :: Pattern Double
     -> (Pattern ValueMap -> Pattern ValueMap)
     -> Pattern ValueMap
     -> Pattern ValueMap
juxBy :: Pattern Double
-> (Pattern ValueMap -> Pattern ValueMap)
-> Pattern ValueMap
-> Pattern ValueMap
juxBy Pattern Double
n Pattern ValueMap -> Pattern ValueMap
f Pattern ValueMap
p = forall a. [Pattern a] -> Pattern a
stack [Pattern ValueMap
p forall a. Num a => Pattern a -> Pattern a -> Pattern a
|+ Pattern Double -> Pattern ValueMap
P.pan Pattern Double
0.5 forall a. Num a => Pattern a -> Pattern a -> Pattern a
|- Pattern Double -> Pattern ValueMap
P.pan (Pattern Double
nforall a. Fractional a => a -> a -> a
/Pattern Double
2), Pattern ValueMap -> Pattern ValueMap
f forall a b. (a -> b) -> a -> b
$ Pattern ValueMap
p forall a. Num a => Pattern a -> Pattern a -> Pattern a
|+ Pattern Double -> Pattern ValueMap
P.pan Pattern Double
0.5 forall a. Num a => Pattern a -> Pattern a -> Pattern a
|+ Pattern Double -> Pattern ValueMap
P.pan (Pattern Double
nforall a. Fractional a => a -> a -> a
/Pattern Double
2)]

pick :: String -> Int -> String
pick :: [Char] -> Int -> [Char]
pick [Char]
name Int
n = [Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
n

-- samples "jvbass [~ latibro] [jvbass [latibro jvbass]]" ((1%2) `rotL` slow 6 "[1 6 8 7 3]")

samples :: Applicative f => f String -> f Int -> f String
samples :: forall (f :: * -> *).
Applicative f =>
f [Char] -> f Int -> f [Char]
samples f [Char]
p f Int
p' = [Char] -> Int -> [Char]
pick forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f [Char]
p forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f Int
p'

samples' :: Applicative f => f String -> f Int -> f String
samples' :: forall (f :: * -> *).
Applicative f =>
f [Char] -> f Int -> f [Char]
samples' f [Char]
p f Int
p' = forall a b c. (a -> b -> c) -> b -> a -> c
flip [Char] -> Int -> [Char]
pick forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Int
p' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f [Char]
p

{-
scrumple :: Time -> Pattern a -> Pattern a -> Pattern a
scrumple o p p' = p'' -- overlay p (o `rotR` p'')
  where p'' = Pattern $ \a -> concatMap
                              (\((s,d), vs) -> map (\x -> ((s,d),
                                                           snd x
                                                          )
                                                   )
                                                   (arc p' (s,s))
                              ) (arc p a)
-}

spreadf :: [a -> Pattern b] -> a -> Pattern b
spreadf :: forall a b. [a -> Pattern b] -> a -> Pattern b
spreadf = forall a t b. (a -> t -> Pattern b) -> [a] -> t -> Pattern b
spread forall a b. (a -> b) -> a -> b
($)

stackwith :: Unionable a => Pattern a -> [Pattern a] -> Pattern a
stackwith :: forall a. Unionable a => Pattern a -> [Pattern a] -> Pattern a
stackwith Pattern a
p [Pattern a]
ps | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Pattern a]
ps = forall a. Pattern a
silence
               | Bool
otherwise = forall a. [Pattern a] -> Pattern a
stack forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(Int
i, Pattern a
p') -> Pattern a
p' forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# ((forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i forall a. Integral a => a -> a -> Ratio a
% Integer
l) forall a. Time -> Pattern a -> Pattern a
`rotL` Pattern a
p)) (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0::Int ..] [Pattern a]
ps)
  where l :: Integer
l = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pattern a]
ps

{-
cross f p p' = Pattern $ \t -> concat [filter flt $ arc p t,
                                       filter (not . flt) $ arc p' t
                                      ]
]  where flt = f . cyclePos . fst . fst
-}

{- | `range` will take a pattern which goes from 0 to 1 (like `sine`), and range it to a different range - between the first and second arguments. In the below example, `range 1 1.5` shifts the range of `sine1` from 0 - 1 to 1 - 1.5.

@
d1 $ jux (iter 4) $ sound "arpy arpy:2*2"
  |+ speed (slow 4 $ range 1 1.5 sine1)
@
-}
range :: Num a => Pattern a -> Pattern a -> Pattern a -> Pattern a
range :: forall a. Num a => Pattern a -> Pattern a -> Pattern a -> Pattern a
range Pattern a
fromP Pattern a
toP Pattern a
p = (\a
from a
to a
v -> ((a
v forall a. Num a => a -> a -> a
* (a
toforall a. Num a => a -> a -> a
-a
from)) forall a. Num a => a -> a -> a
+ a
from)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
fromP forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
*> Pattern a
toP forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
*> Pattern a
p

_range :: (Functor f, Num b) => b -> b -> f b -> f b
_range :: forall (f :: * -> *) b. (Functor f, Num b) => b -> b -> f b -> f b
_range b
from b
to f b
p = (forall a. Num a => a -> a -> a
+ b
from) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
* (b
toforall a. Num a => a -> a -> a
-b
from)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
p

{- | `rangex` is an exponential version of `range`, good for using with
frequencies.  Do *not* use negative numbers or zero as arguments! -}
rangex :: (Functor f, Floating b) => b -> b -> f b -> f b
rangex :: forall (f :: * -> *) b.
(Functor f, Floating b) =>
b -> b -> f b -> f b
rangex b
from b
to f b
p = forall {a}. Floating a => a -> a
exp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) b. (Functor f, Num b) => b -> b -> f b -> f b
_range (forall {a}. Floating a => a -> a
log b
from) (forall {a}. Floating a => a -> a
log b
to) f b
p

off :: Pattern Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
off :: forall a.
Pattern Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
off Pattern Time
tp Pattern a -> Pattern a
f Pattern a
p = forall a. Pattern (Pattern a) -> Pattern a
innerJoin forall a b. (a -> b) -> a -> b
$ (\Time
tv -> forall a.
Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_off Time
tv Pattern a -> Pattern a
f Pattern a
p) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Time
tp

_off :: Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_off :: forall a.
Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_off Time
t Pattern a -> Pattern a
f Pattern a
p = forall a. (Pattern a -> Pattern a) -> Pattern a -> Pattern a
superimpose (Pattern a -> Pattern a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Time
t forall a. Time -> Pattern a -> Pattern a
`rotR`)) Pattern a
p

offadd :: Num a => Pattern Time -> Pattern a -> Pattern a -> Pattern a
offadd :: forall a.
Num a =>
Pattern Time -> Pattern a -> Pattern a -> Pattern a
offadd Pattern Time
tp Pattern a
pn Pattern a
p = forall a.
Pattern Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
off Pattern Time
tp (forall a. Num a => a -> a -> a
+Pattern a
pn) Pattern a
p

-- | Step sequencing
step :: String -> String -> Pattern String
step :: [Char] -> [Char] -> Pattern [Char]
step [Char]
s [Char]
cs = forall a. [Pattern a] -> Pattern a
fastcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Char -> Pattern [Char]
f [Char]
cs
    where f :: Char -> Pattern [Char]
f Char
c | Char
c forall a. Eq a => a -> a -> Bool
== Char
'x' = forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
s
              | Char -> Bool
isDigit Char
c = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [Char]
s forall a. [a] -> [a] -> [a]
++ [Char]
":" forall a. [a] -> [a] -> [a]
++ [Char
c]
              | Bool
otherwise = forall a. Pattern a
silence

steps :: [(String, String)] -> Pattern String
steps :: [([Char], [Char])] -> Pattern [Char]
steps = forall a. [Pattern a] -> Pattern a
stack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Char] -> [Char] -> Pattern [Char]
step)

-- | like `step`, but allows you to specify an array of strings to use for 0,1,2...
step' :: [String] -> String -> Pattern String
step' :: [[Char]] -> [Char] -> Pattern [Char]
step' [[Char]]
ss [Char]
cs = forall a. [Pattern a] -> Pattern a
fastcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Char -> Pattern [Char]
f [Char]
cs
    where f :: Char -> Pattern [Char]
f Char
c | Char
c forall a. Eq a => a -> a -> Bool
== Char
'x' = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [[Char]]
ss
              | Char -> Bool
isDigit Char
c = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [[Char]]
ss forall a. [a] -> Int -> a
!! Char -> Int
digitToInt Char
c
              | Bool
otherwise = forall a. Pattern a
silence


ghost'' :: Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
ghost'' :: forall a.
Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
ghost'' Time
a Pattern a -> Pattern a
f Pattern a
p = forall a. (Pattern a -> Pattern a) -> Pattern a -> Pattern a
superimpose (((Time
aforall a. Num a => a -> a -> a
*Time
2.5) forall a. Time -> Pattern a -> Pattern a
`rotR`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern a -> Pattern a
f) forall a b. (a -> b) -> a -> b
$ forall a. (Pattern a -> Pattern a) -> Pattern a -> Pattern a
superimpose (((Time
aforall a. Num a => a -> a -> a
*Time
1.5) forall a. Time -> Pattern a -> Pattern a
`rotR`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern a -> Pattern a
f) Pattern a
p

ghost' :: Time -> Pattern ValueMap -> Pattern ValueMap
ghost' :: Time -> Pattern ValueMap -> Pattern ValueMap
ghost' Time
a Pattern ValueMap
p = forall a.
Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
ghost'' Time
a ((forall (a :: * -> *) b. (Applicative a, Num b) => a b -> a b -> a b
|*| Pattern Double -> Pattern ValueMap
P.gain (forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
0.7)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
|> Pattern Double -> Pattern ValueMap
P.end (forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
0.2)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (a :: * -> *) b. (Applicative a, Num b) => a b -> a b -> a b
|*| Pattern Double -> Pattern ValueMap
P.speed (forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
1.25))) Pattern ValueMap
p

ghost :: Pattern ValueMap -> Pattern ValueMap
ghost :: Pattern ValueMap -> Pattern ValueMap
ghost = Time -> Pattern ValueMap -> Pattern ValueMap
ghost' Time
0.125

{- |
   tabby - A more literal weaving than the `weave` function, give number
   of 'threads' per cycle and two patterns, and this function will weave them
   together using a plain (aka 'tabby') weave, with a simple over/under structure
 -}
tabby :: Int -> Pattern a -> Pattern a -> Pattern a
tabby :: forall a. Int -> Pattern a -> Pattern a -> Pattern a
tabby Int
nInt Pattern a
p Pattern a
p' = forall a. [Pattern a] -> Pattern a
stack [Pattern a
maskedWarp,
                      Pattern a
maskedWeft
                     ]
  where
    n :: Integer
n = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nInt
    weft :: [[Integer]]
weft = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b. a -> b -> a
const [[Integer
0..Integer
nforall a. Num a => a -> a -> a
-Integer
1], forall a. [a] -> [a]
reverse [Integer
0..Integer
nforall a. Num a => a -> a -> a
-Integer
1]]) [Integer
0 .. (Integer
n forall a. Integral a => a -> a -> a
`div` Integer
2) forall a. Num a => a -> a -> a
- Integer
1]
    warp :: [[Integer]]
warp = forall a. [[a]] -> [[a]]
transpose [[Integer]]
weft
    thread :: t [Integer] -> Pattern a -> Pattern a
thread t [Integer]
xs Pattern a
p'' = forall a. Time -> Pattern a -> Pattern a
_slow (Integer
nforall a. Integral a => a -> a -> Ratio a
%Integer
1) forall a b. (a -> b) -> a -> b
$ forall a. [Pattern a] -> Pattern a
fastcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Integer
i -> forall a. Arc -> Pattern a -> Pattern a
zoomArc (forall a. a -> a -> ArcF a
Arc (Integer
iforall a. Integral a => a -> a -> Ratio a
%Integer
n) ((Integer
iforall a. Num a => a -> a -> a
+Integer
1)forall a. Integral a => a -> a -> Ratio a
%Integer
n)) Pattern a
p'') (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat t [Integer]
xs)
    weftP :: Pattern a
weftP = forall {t :: * -> *} {a}.
Foldable t =>
t [Integer] -> Pattern a -> Pattern a
thread [[Integer]]
weft Pattern a
p'
    warpP :: Pattern a
warpP = forall {t :: * -> *} {a}.
Foldable t =>
t [Integer] -> Pattern a -> Pattern a
thread [[Integer]]
warp Pattern a
p
    maskedWeft :: Pattern a
maskedWeft = forall a. Pattern Bool -> Pattern a -> Pattern a
mask (forall b.
Pattern Int -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b
every Pattern Int
2 forall a. Pattern a -> Pattern a
rev forall a b. (a -> b) -> a -> b
$ forall a. Time -> Pattern a -> Pattern a
_fast (Integer
n forall a. Integral a => a -> a -> Ratio a
% Integer
2) forall a b. (a -> b) -> a -> b
$ forall a. [Pattern a] -> Pattern a
fastCat [forall a. Pattern a
silence, forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True]) Pattern a
weftP
    maskedWarp :: Pattern a
maskedWarp = forall a. Pattern Bool -> Pattern a -> Pattern a
mask (forall b.
Pattern Int -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b
every Pattern Int
2 forall a. Pattern a -> Pattern a
rev forall a b. (a -> b) -> a -> b
$ forall a. Time -> Pattern a -> Pattern a
_fast (Integer
n forall a. Integral a => a -> a -> Ratio a
% Integer
2) forall a b. (a -> b) -> a -> b
$ forall a. [Pattern a] -> Pattern a
fastCat [forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True, forall a. Pattern a
silence]) Pattern a
warpP

-- | chooses between a list of patterns, using a pattern of floats (from 0-1)
select :: Pattern Double -> [Pattern a] -> Pattern a
select :: forall a. Pattern Double -> [Pattern a] -> Pattern a
select = forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam forall a. Double -> [Pattern a] -> Pattern a
_select

_select :: Double -> [Pattern a] -> Pattern a
_select :: forall a. Double -> [Pattern a] -> Pattern a
_select Double
f [Pattern a]
ps =  [Pattern a]
ps forall a. [a] -> Int -> a
!! forall a b. (RealFrac a, Integral b) => a -> b
floor (forall a. Ord a => a -> a -> a
max Double
0 (forall a. Ord a => a -> a -> a
min Double
1 Double
f) forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pattern a]
ps forall a. Num a => a -> a -> a
- Int
1))

-- | chooses between a list of functions, using a pattern of floats (from 0-1)
selectF :: Pattern Double -> [Pattern a -> Pattern a] -> Pattern a -> Pattern a
selectF :: forall a.
Pattern Double
-> [Pattern a -> Pattern a] -> Pattern a -> Pattern a
selectF Pattern Double
pf [Pattern a -> Pattern a]
ps Pattern a
p = forall a. Pattern (Pattern a) -> Pattern a
innerJoin forall a b. (a -> b) -> a -> b
$ (\Double
f -> forall a.
Double -> [Pattern a -> Pattern a] -> Pattern a -> Pattern a
_selectF Double
f [Pattern a -> Pattern a]
ps Pattern a
p) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Double
pf

_selectF :: Double -> [Pattern a -> Pattern a] -> Pattern a -> Pattern a
_selectF :: forall a.
Double -> [Pattern a -> Pattern a] -> Pattern a -> Pattern a
_selectF Double
f [Pattern a -> Pattern a]
ps Pattern a
p =  ([Pattern a -> Pattern a]
ps forall a. [a] -> Int -> a
!! forall a b. (RealFrac a, Integral b) => a -> b
floor (forall a. Ord a => a -> a -> a
max Double
0 (forall a. Ord a => a -> a -> a
min Double
0.999999 Double
f) forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pattern a -> Pattern a]
ps))) Pattern a
p

-- | chooses between a list of functions, using a pattern of integers
pickF :: Pattern Int -> [Pattern a -> Pattern a] -> Pattern a -> Pattern a
pickF :: forall a.
Pattern Int -> [Pattern a -> Pattern a] -> Pattern a -> Pattern a
pickF Pattern Int
pInt [Pattern a -> Pattern a]
fs Pattern a
pat = forall a. Pattern (Pattern a) -> Pattern a
innerJoin forall a b. (a -> b) -> a -> b
$ (\Int
i -> forall a. Int -> [Pattern a -> Pattern a] -> Pattern a -> Pattern a
_pickF Int
i [Pattern a -> Pattern a]
fs Pattern a
pat) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Int
pInt

_pickF :: Int -> [Pattern a -> Pattern a] -> Pattern a -> Pattern a
_pickF :: forall a. Int -> [Pattern a -> Pattern a] -> Pattern a -> Pattern a
_pickF Int
i [Pattern a -> Pattern a]
fs Pattern a
p =  ([Pattern a -> Pattern a]
fs forall a. [a] -> Int -> a
!!! Int
i) Pattern a
p

-- | @contrast p f f' p'@ splits controlpattern @p'@ in two, applying
-- the function @f@ to one and @f'@ to the other. This depends on
-- whether events in it contains values matching with those in @p@.
-- For example in @contrast (# crush 3) (# vowel "a") (n "1") $ n "0 1" # s "bd sn" # speed 3@,
-- the first event will have the vowel effect applied and the second
-- will have the crush applied.
contrast :: (ControlPattern -> ControlPattern) -> (ControlPattern -> ControlPattern)
            -> ControlPattern -> ControlPattern -> ControlPattern
contrast :: (Pattern ValueMap -> Pattern ValueMap)
-> (Pattern ValueMap -> Pattern ValueMap)
-> Pattern ValueMap
-> Pattern ValueMap
-> Pattern ValueMap
contrast = forall a b.
(a -> Value -> Bool)
-> (Pattern ValueMap -> Pattern b)
-> (Pattern ValueMap -> Pattern b)
-> Pattern (Map [Char] a)
-> Pattern ValueMap
-> Pattern b
contrastBy forall a. Eq a => a -> a -> Bool
(==)

contrastBy :: (a -> Value -> Bool)
              -> (ControlPattern -> Pattern b)
              -> (ControlPattern -> Pattern b)
              -> Pattern (Map.Map String a)
              -> Pattern (Map.Map String Value)
              -> Pattern b
contrastBy :: forall a b.
(a -> Value -> Bool)
-> (Pattern ValueMap -> Pattern b)
-> (Pattern ValueMap -> Pattern b)
-> Pattern (Map [Char] a)
-> Pattern ValueMap
-> Pattern b
contrastBy a -> Value -> Bool
comp Pattern ValueMap -> Pattern b
f Pattern ValueMap -> Pattern b
f' Pattern (Map [Char] a)
p Pattern ValueMap
p' = forall a. Pattern a -> Pattern a -> Pattern a
overlay (Pattern ValueMap -> Pattern b
f Pattern ValueMap
matched) (Pattern ValueMap -> Pattern b
f' Pattern ValueMap
unmatched)
  where matches :: Pattern (Bool, ValueMap)
matches = forall b a.
(b -> a -> Bool) -> Pattern a -> Pattern b -> Pattern (Bool, b)
matchManyToOne (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
$ forall k a b.
Ord k =>
(a -> b -> Bool) -> Map k a -> Map k b -> Bool
Map.isSubmapOfBy a -> Value -> Bool
comp) Pattern (Map [Char] a)
p Pattern ValueMap
p'
        matched :: ControlPattern
        matched :: Pattern ValueMap
matched = forall a. Pattern (Maybe a) -> Pattern a
filterJust forall a b. (a -> b) -> a -> b
$ (\(Bool
t, ValueMap
a) -> if Bool
t then forall a. a -> Maybe a
Just ValueMap
a else forall a. Maybe a
Nothing) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern (Bool, ValueMap)
matches
        unmatched :: ControlPattern
        unmatched :: Pattern ValueMap
unmatched = forall a. Pattern (Maybe a) -> Pattern a
filterJust forall a b. (a -> b) -> a -> b
$ (\(Bool
t, ValueMap
a) -> if Bool -> Bool
not Bool
t then forall a. a -> Maybe a
Just ValueMap
a else forall a. Maybe a
Nothing) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern (Bool, ValueMap)
matches

contrastRange
  :: (ControlPattern -> Pattern a)
     -> (ControlPattern -> Pattern a)
     -> Pattern (Map.Map String (Value, Value))
     -> ControlPattern
     -> Pattern a
contrastRange :: forall a.
(Pattern ValueMap -> Pattern a)
-> (Pattern ValueMap -> Pattern a)
-> Pattern (Map [Char] (Value, Value))
-> Pattern ValueMap
-> Pattern a
contrastRange = forall a b.
(a -> Value -> Bool)
-> (Pattern ValueMap -> Pattern b)
-> (Pattern ValueMap -> Pattern b)
-> Pattern (Map [Char] a)
-> Pattern ValueMap
-> Pattern b
contrastBy (Value, Value) -> Value -> Bool
f
      where f :: (Value, Value) -> Value -> Bool
f (VI Int
s, VI Int
e) (VI Int
v) = Int
v forall a. Ord a => a -> a -> Bool
>= Int
s Bool -> Bool -> Bool
&& Int
v forall a. Ord a => a -> a -> Bool
<= Int
e
            f (VF Double
s, VF Double
e) (VF Double
v) = Double
v forall a. Ord a => a -> a -> Bool
>= Double
s Bool -> Bool -> Bool
&& Double
v forall a. Ord a => a -> a -> Bool
<= Double
e
            f (VN Note
s, VN Note
e) (VN Note
v) = Note
v forall a. Ord a => a -> a -> Bool
>= Note
s Bool -> Bool -> Bool
&& Note
v forall a. Ord a => a -> a -> Bool
<= Note
e
            f (VS [Char]
s, VS [Char]
e) (VS [Char]
v) = [Char]
v forall a. Eq a => a -> a -> Bool
== [Char]
s Bool -> Bool -> Bool
&& [Char]
v forall a. Eq a => a -> a -> Bool
== [Char]
e
            f (Value, Value)
_ Value
_ = Bool
False

-- | Like @contrast@, but one function is given, and applied to events with matching controls.
fix :: (ControlPattern -> ControlPattern) -> ControlPattern -> ControlPattern -> ControlPattern
fix :: (Pattern ValueMap -> Pattern ValueMap)
-> Pattern ValueMap -> Pattern ValueMap -> Pattern ValueMap
fix Pattern ValueMap -> Pattern ValueMap
f = (Pattern ValueMap -> Pattern ValueMap)
-> (Pattern ValueMap -> Pattern ValueMap)
-> Pattern ValueMap
-> Pattern ValueMap
-> Pattern ValueMap
contrast Pattern ValueMap -> Pattern ValueMap
f forall a. a -> a
id

-- | Like @contrast@, but one function is given, and applied to events
-- with controls which don't match.
unfix :: (ControlPattern -> ControlPattern) -> ControlPattern -> ControlPattern -> ControlPattern
unfix :: (Pattern ValueMap -> Pattern ValueMap)
-> Pattern ValueMap -> Pattern ValueMap -> Pattern ValueMap
unfix = (Pattern ValueMap -> Pattern ValueMap)
-> (Pattern ValueMap -> Pattern ValueMap)
-> Pattern ValueMap
-> Pattern ValueMap
-> Pattern ValueMap
contrast forall a. a -> a
id

fixRange :: (ControlPattern -> Pattern ValueMap)
            -> Pattern (Map.Map String (Value, Value))
            -> ControlPattern
            -> ControlPattern
fixRange :: (Pattern ValueMap -> Pattern ValueMap)
-> Pattern (Map [Char] (Value, Value))
-> Pattern ValueMap
-> Pattern ValueMap
fixRange Pattern ValueMap -> Pattern ValueMap
f = forall a.
(Pattern ValueMap -> Pattern a)
-> (Pattern ValueMap -> Pattern a)
-> Pattern (Map [Char] (Value, Value))
-> Pattern ValueMap
-> Pattern a
contrastRange Pattern ValueMap -> Pattern ValueMap
f forall a. a -> a
id

unfixRange :: (ControlPattern -> Pattern ValueMap)
              -> Pattern (Map.Map String (Value, Value))
              -> ControlPattern
              -> ControlPattern
unfixRange :: (Pattern ValueMap -> Pattern ValueMap)
-> Pattern (Map [Char] (Value, Value))
-> Pattern ValueMap
-> Pattern ValueMap
unfixRange = forall a.
(Pattern ValueMap -> Pattern a)
-> (Pattern ValueMap -> Pattern a)
-> Pattern (Map [Char] (Value, Value))
-> Pattern ValueMap
-> Pattern a
contrastRange forall a. a -> a
id

-- | limit values in a Pattern (or other Functor) to n equally spaced
-- divisions of 1.
quantise :: (Functor f, RealFrac b) => b -> f b -> f b
quantise :: forall (f :: * -> *) b. (Functor f, RealFrac b) => b -> f b -> f b
quantise b
n = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall a. Fractional a => a -> a -> a
/b
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: RealFrac b => Int -> b) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (RealFrac a, Integral b) => a -> b
round forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
*b
n))

-- quantise but with floor
qfloor :: (Functor f, RealFrac b) => b -> f b -> f b
qfloor :: forall (f :: * -> *) b. (Functor f, RealFrac b) => b -> f b -> f b
qfloor b
n = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall a. Fractional a => a -> a -> a
/b
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: RealFrac b => Int -> b) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (RealFrac a, Integral b) => a -> b
floor forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
*b
n))

qceiling :: (Functor f, RealFrac b) => b -> f b -> f b
qceiling :: forall (f :: * -> *) b. (Functor f, RealFrac b) => b -> f b -> f b
qceiling b
n = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall a. Fractional a => a -> a -> a
/b
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: RealFrac b => Int -> b) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (RealFrac a, Integral b) => a -> b
ceiling forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
*b
n))

qround :: (Functor f, RealFrac b) => b -> f b -> f b
qround :: forall (f :: * -> *) b. (Functor f, RealFrac b) => b -> f b -> f b
qround = forall (f :: * -> *) b. (Functor f, RealFrac b) => b -> f b -> f b
quantise

-- | Inverts all the values in a boolean pattern
inv :: Functor f => f Bool -> f Bool
inv :: forall (f :: * -> *). Functor f => f Bool -> f Bool
inv = (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)

-- | Serialises a pattern so there's only one event playing at any one
-- time, making it 'monophonic'. Events which start/end earlier are given priority.
mono :: Pattern a -> Pattern a
mono :: forall a. Pattern a -> Pattern a
mono Pattern a
p = forall a. (State -> [Event a]) -> Pattern a
Pattern forall a b. (a -> b) -> a -> b
$ \(State Arc
a ValueMap
cm) -> forall {b}. [EventF Arc b] -> [EventF Arc b]
flatten forall a b. (a -> b) -> a -> b
$ forall a. Pattern a -> State -> [Event a]
query Pattern a
p (Arc -> ValueMap -> State
State Arc
a ValueMap
cm) where
  flatten :: [Event a] -> [Event a]
  flatten :: forall {b}. [EventF Arc b] -> [EventF Arc b]
flatten = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall a. Event a -> Maybe (Event a)
constrainPart forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {b}. [EventF Arc b] -> [EventF Arc b]
truncateOverlaps forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a b. EventF a b -> Maybe a
whole
  truncateOverlaps :: [Event a] -> [Event a]
truncateOverlaps [] = []
  truncateOverlaps (Event a
e:[Event a]
es) = Event a
e forall a. a -> [a] -> [a]
: [Event a] -> [Event a]
truncateOverlaps (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall {a} {a}. Event a -> Event a -> Maybe (Event a)
snip Event a
e) [Event a]
es)
  -- TODO - decide what to do about analog events..
  snip :: Event a -> Event a -> Maybe (Event a)
snip Event a
a Event a
b | forall a. ArcF a -> a
start (forall a. Event a -> Arc
wholeOrPart Event a
b) forall a. Ord a => a -> a -> Bool
>= forall a. ArcF a -> a
stop (forall a. Event a -> Arc
wholeOrPart Event a
a) = forall a. a -> Maybe a
Just Event a
b
           | forall a. ArcF a -> a
stop (forall a. Event a -> Arc
wholeOrPart Event a
b) forall a. Ord a => a -> a -> Bool
<= forall a. ArcF a -> a
stop (forall a. Event a -> Arc
wholeOrPart Event a
a) = forall a. Maybe a
Nothing
           | Bool
otherwise = forall a. a -> Maybe a
Just Event a
b {whole :: Maybe Arc
whole = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> ArcF a
Arc (forall a. ArcF a -> a
stop forall a b. (a -> b) -> a -> b
$ forall a. Event a -> Arc
wholeOrPart Event a
a) (forall a. ArcF a -> a
stop forall a b. (a -> b) -> a -> b
$ forall a. Event a -> Arc
wholeOrPart Event a
b)}
  constrainPart :: Event a -> Maybe (Event a)
  constrainPart :: forall a. Event a -> Maybe (Event a)
constrainPart Event a
e = do Arc
a <- Arc -> Arc -> Maybe Arc
subArc (forall a. Event a -> Arc
wholeOrPart Event a
e) (forall a b. EventF a b -> a
part Event a
e)
                       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Event a
e {part :: Arc
part = Arc
a}

-- serialize the given pattern
-- find the middle of the query's arc and use that to query the serialized pattern. We should get either no events or a single event back
-- if we don't get any events, return nothing
-- if we get an event, get the stop of its arc, and use that to query the serialized pattern, to see if there's an adjoining event
-- if there isn't, return the event as-is.
-- if there is, check where we are in the 'whole' of the event, and use that to tween between the values of the event and the next event
-- smooth :: Pattern Double -> Pattern Double

-- TODO - test this with analog events
smooth :: Fractional a => Pattern a -> Pattern a
smooth :: forall a. Fractional a => Pattern a -> Pattern a
smooth Pattern a
p = forall a. (State -> [Event a]) -> Pattern a
Pattern forall a b. (a -> b) -> a -> b
$ \st :: State
st@(State Arc
a ValueMap
cm) -> forall {a}. State -> a -> [Event a] -> [EventF a a]
tween State
st Arc
a forall a b. (a -> b) -> a -> b
$ forall a. Pattern a -> State -> [Event a]
query Pattern a
monoP (Arc -> ValueMap -> State
State (forall {a}. Fractional a => ArcF a -> ArcF a
midArc Arc
a) ValueMap
cm)
  where
    midArc :: ArcF a -> ArcF a
midArc ArcF a
a = forall a. a -> a -> ArcF a
Arc (forall a. Fractional a => (a, a) -> a
mid (forall a. ArcF a -> a
start ArcF a
a, forall a. ArcF a -> a
stop ArcF a
a)) (forall a. Fractional a => (a, a) -> a
mid (forall a. ArcF a -> a
start ArcF a
a, forall a. ArcF a -> a
stop ArcF a
a))
    tween :: State -> a -> [Event a] -> [EventF a a]
tween State
_ a
_ [] = []
    tween State
st a
queryA (Event a
e:[Event a]
_) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Event a
e {whole :: Maybe a
whole = forall a. a -> Maybe a
Just a
queryA, part :: a
part = a
queryA}] (forall {a}. a -> a -> [EventF a a]
tween' a
queryA) (State -> Maybe a
nextV State
st)
      where aStop :: Arc
aStop = forall a. a -> a -> ArcF a
Arc (forall a. Event a -> Time
wholeStop Event a
e) (forall a. Event a -> Time
wholeStop Event a
e)
            nextEs :: State -> [Event a]
nextEs State
st' = forall a. Pattern a -> State -> [Event a]
query Pattern a
monoP (State
st' {arc :: Arc
arc = Arc
aStop})
            nextV :: State -> Maybe a
nextV State
st' | forall (t :: * -> *) a. Foldable t => t a -> Bool
null (State -> [Event a]
nextEs State
st') = forall a. Maybe a
Nothing
                      | Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. EventF a b -> b
value (forall a. [a] -> a
head (State -> [Event a]
nextEs State
st'))
            tween' :: a -> a -> [EventF a a]
tween' a
queryA' a
v =
              [ Event
                { context :: Context
context = forall a b. EventF a b -> Context
context Event a
e,
                  whole :: Maybe a
whole = forall a. a -> Maybe a
Just a
queryA'
                , part :: a
part = a
queryA'
                , value :: a
value = forall a b. EventF a b -> b
value Event a
e forall a. Num a => a -> a -> a
+ ((a
v forall a. Num a => a -> a -> a
- forall a b. EventF a b -> b
value Event a
e) forall a. Num a => a -> a -> a
* a
pc)}
              ]
            pc :: a
pc | forall {a}. Num a => ArcF a -> a
delta' (forall a. Event a -> Arc
wholeOrPart Event a
e) forall a. Eq a => a -> a -> Bool
== Time
0 = a
0
               | Bool
otherwise = forall a. Fractional a => Time -> a
fromRational forall a b. (a -> b) -> a -> b
$ (forall a. Event a -> Time
eventPartStart Event a
e forall a. Num a => a -> a -> a
- forall a. Event a -> Time
wholeStart Event a
e) forall a. Fractional a => a -> a -> a
/ forall {a}. Num a => ArcF a -> a
delta' (forall a. Event a -> Arc
wholeOrPart Event a
e)
            delta' :: ArcF a -> a
delta' ArcF a
a = forall a. ArcF a -> a
stop ArcF a
a forall a. Num a => a -> a -> a
- forall a. ArcF a -> a
start ArcF a
a
    monoP :: Pattern a
monoP = forall a. Pattern a -> Pattern a
mono Pattern a
p

-- | Looks up values from a list of tuples, in order to swap values in the given pattern
swap :: Eq a => [(a, b)] -> Pattern a -> Pattern b
swap :: forall a b. Eq a => [(a, b)] -> Pattern a -> Pattern b
swap [(a, b)]
things Pattern a
p = forall a. Pattern (Maybe a) -> Pattern a
filterJust forall a b. (a -> b) -> a -> b
$ (forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(a, b)]
things) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
p

{-
  snowball |
  snowball takes a function that can combine patterns (like '+'),
  a function that transforms a pattern (like 'slow'),
  a depth, and a starting pattern,
  it will then transform the pattern and combine it with the last transformation until the depth is reached
  this is like putting an effect (like a filter) in the feedback of a delay line
  each echo is more effected
  d1 $ note (scale "hexDorian" $ snowball (+) (slow 2 . rev) 8 "0 ~ . -1 . 5 3 4 . ~ -2") # s "gtr"
-}
snowball :: Int -> (Pattern a -> Pattern a -> Pattern a) -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
snowball :: forall a.
Int
-> (Pattern a -> Pattern a -> Pattern a)
-> (Pattern a -> Pattern a)
-> Pattern a
-> Pattern a
snowball Int
depth Pattern a -> Pattern a -> Pattern a
combinationFunction Pattern a -> Pattern a
f Pattern a
pattern = forall a. [Pattern a] -> Pattern a
cat forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take Int
depth forall a b. (a -> b) -> a -> b
$ forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Pattern a -> Pattern a -> Pattern a
combinationFunction Pattern a
pattern forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
1 forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> a -> [a]
iterate Pattern a -> Pattern a
f Pattern a
pattern

{- @soak@ |
    applies a function to a pattern and cats the resulting pattern,
    then continues applying the function until the depth is reached
    this can be used to create a pattern that wanders away from
    the original pattern by continually adding random numbers
    d1 $ note (scale "hexDorian" mutateBy (+ (range -1 1 $ irand 2)) 8 $ "0 1 . 2 3 4") # s "gtr"
-}
soak ::  Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
soak :: forall a. Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
soak Int
depth Pattern a -> Pattern a
f Pattern a
pattern = forall a. [Pattern a] -> Pattern a
cat forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take Int
depth forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> a -> [a]
iterate Pattern a -> Pattern a
f Pattern a
pattern

deconstruct :: Int -> Pattern String -> String
deconstruct :: Int -> Pattern [Char] -> [Char]
deconstruct Int
n Pattern [Char]
p = forall a. [a] -> [[a]] -> [a]
intercalate [Char]
" " forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map [[Char]] -> [Char]
showStep forall a b. (a -> b) -> a -> b
$ forall a. Pattern a -> [[a]]
toList Pattern [Char]
p
  where
    showStep :: [String] -> String
    showStep :: [[Char]] -> [Char]
showStep [] = [Char]
"~"
    showStep [[Char]
x] = [Char]
x
    showStep [[Char]]
xs = [Char]
"[" forall a. [a] -> [a] -> [a]
++ (forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " [[Char]]
xs) forall a. [a] -> [a] -> [a]
++ [Char]
"]"
    toList :: Pattern a -> [[a]]
    toList :: forall a. Pattern a -> [[a]]
toList Pattern a
pat = forall a b. (a -> b) -> [a] -> [b]
map (\(Time
s,Time
e) -> forall a b. (a -> b) -> [a] -> [b]
map forall a b. EventF a b -> b
value forall a b. (a -> b) -> a -> b
$ forall a. Pattern a -> Arc -> [Event a]
queryArc (forall a. Time -> Pattern a -> Pattern a
_segment Time
n' Pattern a
pat) (forall a. a -> a -> ArcF a
Arc Time
s Time
e)) [(Time, Time)]
arcs
      where breaks :: [Time]
breaks = [Time
0, (Time
1forall a. Fractional a => a -> a -> a
/Time
n') ..]
            arcs :: [(Time, Time)]
arcs = forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. Int -> [a] -> [a]
take Int
n [Time]
breaks) (forall a. Int -> [a] -> [a]
drop Int
1 [Time]
breaks)
            n' :: Time
n' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n

{- @bite@ n ipat pat |
  slices a pattern `pat` into `n` pieces, then uses the `ipat` pattern of integers to index into those slices.
  So `bite 4 "0 2*2" (run 8)` is the same as `"[0 1] [4 5]*2"`.
-}
bite :: Pattern Int -> Pattern Int -> Pattern a -> Pattern a
bite :: forall a. Pattern Int -> Pattern Int -> Pattern a -> Pattern a
bite Pattern Int
npat Pattern Int
ipat Pattern a
pat = forall a. Pattern (Pattern a) -> Pattern a
innerJoin forall a b. (a -> b) -> a -> b
$ (\Int
n -> forall a. Int -> Pattern Int -> Pattern a -> Pattern a
_bite Int
n Pattern Int
ipat Pattern a
pat) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Int
npat

_bite :: Int -> Pattern Int -> Pattern a -> Pattern a
_bite :: forall a. Int -> Pattern Int -> Pattern a -> Pattern a
_bite Int
n Pattern Int
ipat Pattern a
pat = forall a. Pattern (Pattern a) -> Pattern a
squeezeJoin forall a b. (a -> b) -> a -> b
$ Int -> Pattern a
zoompat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Int
ipat
  where zoompat :: Int -> Pattern a
zoompat Int
i = forall a. (Time, Time) -> Pattern a -> Pattern a
zoom (Time
i'forall a. Fractional a => a -> a -> a
/(forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n), (Time
i'forall a. Num a => a -> a -> a
+Time
1)forall a. Fractional a => a -> a -> a
/(forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)) Pattern a
pat
           where i' :: Time
i' = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
i forall a. Integral a => a -> a -> a
`mod` Int
n

{- @squeeze@ ipat pats | uses a pattern of integers to index into a list of patterns.
-}
squeeze :: Pattern Int -> [Pattern a] -> Pattern a
squeeze :: forall a. Pattern Int -> [Pattern a] -> Pattern a
squeeze Pattern Int
_ [] = forall a. Pattern a
silence
squeeze Pattern Int
ipat [Pattern a]
pats = forall a. Pattern (Pattern a) -> Pattern a
squeezeJoin forall a b. (a -> b) -> a -> b
$ ([Pattern a]
pats forall a. [a] -> Int -> a
!!!) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Int
ipat

squeezeJoinUp :: Pattern (ControlPattern) -> ControlPattern
squeezeJoinUp :: Pattern (Pattern ValueMap) -> Pattern ValueMap
squeezeJoinUp Pattern (Pattern ValueMap)
pp = Pattern (Pattern ValueMap)
pp {query :: State -> [Event ValueMap]
query = State -> [Event ValueMap]
q}
  where q :: State -> [Event ValueMap]
q State
st = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (State -> EventF Arc (Pattern ValueMap) -> [Event ValueMap]
f State
st) (forall a. Pattern a -> State -> [Event a]
query (forall a. Pattern a -> Pattern a
filterDigital Pattern (Pattern ValueMap)
pp) State
st)
        f :: State -> EventF Arc (Pattern ValueMap) -> [Event ValueMap]
f State
st (Event Context
c (Just Arc
w) Arc
p Pattern ValueMap
v) =
          forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall {b}.
Context -> Arc -> Arc -> EventF Arc b -> Maybe (EventF Arc b)
munge Context
c Arc
w Arc
p) forall a b. (a -> b) -> a -> b
$ forall a. Pattern a -> State -> [Event a]
query (forall a. Arc -> Pattern a -> Pattern a
compressArc (Arc -> Arc
cycleArc Arc
w) (Pattern ValueMap
v forall a. Num a => Pattern a -> Pattern a -> Pattern a
|* Pattern Double -> Pattern ValueMap
P.speed (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Fractional a => Time -> a
fromRational forall a b. (a -> b) -> a -> b
$ Time
1forall a. Fractional a => a -> a -> a
/(forall a. ArcF a -> a
stop Arc
w forall a. Num a => a -> a -> a
- forall a. ArcF a -> a
start Arc
w)))) State
st {arc :: Arc
arc = Arc
p}
        -- already ignoring analog events, but for completeness..
        f State
_ EventF Arc (Pattern ValueMap)
_ = []
        munge :: Context -> Arc -> Arc -> EventF Arc b -> Maybe (EventF Arc b)
munge Context
co Arc
oWhole Arc
oPart (Event Context
ci (Just Arc
iWhole) Arc
iPart b
v) =
          do Arc
w' <- Arc -> Arc -> Maybe Arc
subArc Arc
oWhole Arc
iWhole
             Arc
p' <- Arc -> Arc -> Maybe Arc
subArc Arc
oPart Arc
iPart
             forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event ([Context] -> Context
combineContexts [Context
ci,Context
co]) (forall a. a -> Maybe a
Just Arc
w') Arc
p' b
v)
        munge Context
_ Arc
_ Arc
_ EventF Arc b
_ = forall a. Maybe a
Nothing

_chew :: Int -> Pattern Int -> ControlPattern  -> ControlPattern
_chew :: Int -> Pattern Int -> Pattern ValueMap -> Pattern ValueMap
_chew Int
n Pattern Int
ipat Pattern ValueMap
pat = (Pattern (Pattern ValueMap) -> Pattern ValueMap
squeezeJoinUp forall a b. (a -> b) -> a -> b
$ Int -> Pattern ValueMap
zoompat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Int
ipat) forall a. Fractional a => Pattern a -> Pattern a -> Pattern a
|/ Pattern Double -> Pattern ValueMap
P.speed (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
  where zoompat :: Int -> Pattern ValueMap
zoompat Int
i = forall a. (Time, Time) -> Pattern a -> Pattern a
zoom (Time
i'forall a. Fractional a => a -> a -> a
/(forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n), (Time
i'forall a. Num a => a -> a -> a
+Time
1)forall a. Fractional a => a -> a -> a
/(forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)) (Pattern ValueMap
pat)
           where i' :: Time
i' = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
i forall a. Integral a => a -> a -> a
`mod` Int
n

-- TODO maybe _chew could pattern the first parameter directly..
chew :: Pattern Int -> Pattern Int -> ControlPattern  -> ControlPattern
chew :: Pattern Int -> Pattern Int -> Pattern ValueMap -> Pattern ValueMap
chew Pattern Int
npat Pattern Int
ipat Pattern ValueMap
pat = forall a. Pattern (Pattern a) -> Pattern a
innerJoin forall a b. (a -> b) -> a -> b
$ (\Int
n -> Int -> Pattern Int -> Pattern ValueMap -> Pattern ValueMap
_chew Int
n Pattern Int
ipat Pattern ValueMap
pat) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Int
npat

__binary :: Data.Bits.Bits b => Int -> b -> [Bool]
__binary :: forall b. Bits b => Int -> b -> [Bool]
__binary Int
n b
num = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Bits a => a -> Int -> Bool
testBit b
num) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [Int
0 .. Int
nforall a. Num a => a -> a -> a
-Int
1]

_binary :: Data.Bits.Bits b => Int -> b -> Pattern Bool
_binary :: forall b. Bits b => Int -> b -> Pattern Bool
_binary Int
n b
num = forall a. [a] -> Pattern a
listToPat forall a b. (a -> b) -> a -> b
$ forall b. Bits b => Int -> b -> [Bool]
__binary Int
n b
num

_binaryN :: Int -> Pattern Int -> Pattern Bool
_binaryN :: Int -> Pattern Int -> Pattern Bool
_binaryN Int
n Pattern Int
p = forall a. Pattern (Pattern a) -> Pattern a
squeezeJoin forall a b. (a -> b) -> a -> b
$ forall b. Bits b => Int -> b -> Pattern Bool
_binary Int
n forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Int
p

binaryN :: Pattern Int -> Pattern Int -> Pattern Bool
binaryN :: Pattern Int -> Pattern Int -> Pattern Bool
binaryN Pattern Int
n Pattern Int
p = forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam Int -> Pattern Int -> Pattern Bool
_binaryN Pattern Int
n Pattern Int
p

binary :: Pattern Int -> Pattern Bool
binary :: Pattern Int -> Pattern Bool
binary = Pattern Int -> Pattern Int -> Pattern Bool
binaryN Pattern Int
8

ascii :: Pattern String -> Pattern Bool
ascii :: Pattern [Char] -> Pattern Bool
ascii Pattern [Char]
p = forall a. Pattern (Pattern a) -> Pattern a
squeezeJoin forall a b. (a -> b) -> a -> b
$ (forall a. [a] -> Pattern a
listToPat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall b. Bits b => Int -> b -> [Bool]
__binary Int
8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern [Char]
p

grain :: Pattern Double -> Pattern Double -> ControlPattern
grain :: Pattern Double -> Pattern Double -> Pattern ValueMap
grain Pattern Double
s Pattern Double
w = Pattern Double -> Pattern ValueMap
P.begin Pattern Double
b forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> Pattern ValueMap
P.end Pattern Double
e
  where b :: Pattern Double
b = Pattern Double
s
        e :: Pattern Double
e = Pattern Double
s forall a. Num a => a -> a -> a
+ Pattern Double
w

-- | For specifying a boolean pattern according to a list of offsets
-- (aka inter-onset intervals).  For example `necklace 12 [4,2]` is
-- the same as "t f f f t f t f f f t f". That is, 12 steps per cycle,
-- with true values alternating between every 4 and every 2 steps.
necklace :: Rational -> [Int] -> Pattern Bool
necklace :: Time -> [Int] -> Pattern Bool
necklace Time
perCycle [Int]
xs = forall a. Time -> Pattern a -> Pattern a
_slow ((forall a. Real a => a -> Time
toRational forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
xs) forall a. Fractional a => a -> a -> a
/ Time
perCycle) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Pattern a
listToPat forall a b. (a -> b) -> a -> b
$ [Int] -> [Bool]
list [Int]
xs
  where list :: [Int] -> [Bool]
        list :: [Int] -> [Bool]
list [] = []
        list (Int
x:[Int]
xs') = (Bool
Trueforall a. a -> [a] -> [a]
:(forall a. Int -> a -> [a]
replicate (Int
xforall a. Num a => a -> a -> a
-Int
1) Bool
False)) forall a. [a] -> [a] -> [a]
++ [Int] -> [Bool]
list [Int]
xs'