{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, OverloadedStrings #-}
module Sound.Tidal.UI where
import Prelude hiding ((<*), (*>))
import Data.Char (digitToInt, isDigit, ord)
import Data.Bits (testBit, Bits, xor, shiftL, shiftR)
import Data.Fixed (mod')
import Data.Ratio ((%))
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
xorwise :: Int -> Int
xorwise :: Int -> Int
xorwise Int
x =
let a :: Int
a = Int -> Int -> Int
forall a. Bits a => a -> a -> a
xor (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL Int
x Int
13) Int
x
b :: Int
b = Int -> Int -> Int
forall a. Bits a => a -> a -> a
xor (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR Int
a Int
17) Int
a
in Int -> Int -> Int
forall a. Bits a => a -> a -> a
xor (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL Int
b Int
5) Int
b
timeToIntSeed :: RealFrac a => a -> Int
timeToIntSeed :: forall a. RealFrac a => a -> Int
timeToIntSeed = Int -> Int
xorwise (Int -> Int) -> (a -> Int) -> a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate (a -> Int) -> (a -> a) -> a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> a
forall a. Num a => a -> a -> a
* a
536870912) (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, a) -> a
forall a b. (a, b) -> b
snd ((Int, a) -> a) -> (a -> (Int, a)) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall {a}. RealFrac a => a -> (Int, a)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction :: (RealFrac a => a -> (Int,a))) (a -> (Int, a)) -> (a -> a) -> a -> (Int, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
300)
intSeedToRand :: Fractional a => Int -> a
intSeedToRand :: forall a. Fractional a => Int -> a
intSeedToRand = (a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
536870912) (a -> a) -> (Int -> a) -> Int -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Int -> a) -> (Int -> Int) -> Int -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
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 = Int -> b
forall a. Fractional a => Int -> a
intSeedToRand (Int -> b) -> (a -> Int) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
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 = Int -> Int -> [b]
forall a. Fractional a => Int -> Int -> [a]
timeToRands' (a -> Int
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = []
| Bool
otherwise = (Int -> a
forall a. Fractional a => Int -> a
intSeedToRand Int
seed) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (Int -> Int -> [a]
forall a. Fractional a => Int -> Int -> [a]
timeToRands' (Int -> Int
xorwise Int
seed) (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
rand :: Fractional a => Pattern a
rand :: forall a. Fractional a => Pattern a
rand = (State -> [Event a]) -> Pattern a
forall a. (State -> [Event a]) -> Pattern a
Pattern (\(State a :: Arc
a@(Arc Rational
s Rational
e) ValueMap
_) -> [Context -> Maybe Arc -> Arc -> a -> Event a
forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event ([((Int, Int), (Int, Int))] -> Context
Context []) Maybe Arc
forall a. Maybe a
Nothing Arc
a (Double -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> a) -> Double -> a
forall a b. (a -> b) -> a -> b
$ (Rational -> Double
forall a b. (RealFrac a, Fractional b) => a -> b
timeToRand ((Rational
e Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
s)Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
2) :: Double))])
brand :: Pattern Bool
brand :: Pattern Bool
brand = Double -> Pattern Bool
_brandBy Double
0.5
brandBy :: Pattern Double -> Pattern Bool
brandBy :: Pattern Double -> Pattern Bool
brandBy Pattern Double
probpat = Pattern (Pattern Bool) -> Pattern Bool
forall a. Pattern (Pattern a) -> Pattern a
innerJoin (Pattern (Pattern Bool) -> Pattern Bool)
-> Pattern (Pattern Bool) -> Pattern Bool
forall a b. (a -> b) -> a -> b
$ (\Double
prob -> Double -> Pattern Bool
_brandBy Double
prob) (Double -> Pattern Bool)
-> Pattern Double -> Pattern (Pattern Bool)
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 = (Double -> Bool) -> Pattern Double -> Pattern Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
prob) Pattern Double
forall a. Fractional a => Pattern a
rand
irand :: Num a => Pattern Int -> Pattern a
irand :: forall a. Num a => Pattern Int -> Pattern a
irand = (Pattern Int -> (Int -> Pattern a) -> Pattern a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Pattern a
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 = Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> a) -> (Double -> Int) -> Double -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor :: Double -> Int) (Double -> Int) -> (Double -> Double) -> Double -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i) (Double -> a) -> Pattern Double -> Pattern a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Double
forall a. Fractional a => Pattern a
rand
perlinWith :: Fractional a => Pattern Double -> Pattern a
perlinWith :: forall a. Fractional a => Pattern Double -> Pattern a
perlinWith Pattern Double
p = (Double -> a) -> Pattern Double -> Pattern a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Pattern Double -> Pattern a) -> Pattern Double -> Pattern a
forall a b. (a -> b) -> a -> b
$ (Double -> Double -> Double -> Double
forall {a}. Floating a => a -> a -> a -> a
interp) (Double -> Double -> Double -> Double)
-> Pattern Double -> Pattern (Double -> Double -> Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Pattern Double
pPattern Double -> Pattern Double -> Pattern Double
forall a. Num a => a -> a -> a
-Pattern Double
pa) Pattern (Double -> Double -> Double)
-> Pattern Double -> Pattern (Double -> Double)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Double -> Double
forall a b. (RealFrac a, Fractional b) => a -> b
timeToRand (Double -> Double) -> Pattern Double -> Pattern Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Double
pa) Pattern (Double -> Double) -> Pattern Double -> Pattern Double
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Double -> Double
forall a b. (RealFrac a, Fractional b) => a -> b
timeToRand (Double -> Double) -> Pattern Double -> Pattern Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Double
pb) where
pa :: Pattern Double
pa = (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Double) (Int -> Double) -> (Double -> Int) -> Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Double) -> Pattern Double -> Pattern Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Double
p
pb :: Pattern Double
pb = (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Double) (Int -> Double) -> (Double -> Int) -> Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int -> Int) -> (Double -> Int) -> Double -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Double) -> Pattern Double -> Pattern Double
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 a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall {a}. Floating a => a -> a
smootherStep a
x a -> a -> a
forall a. Num a => a -> a -> a
* (a
ba -> a -> a
forall a. Num a => a -> a -> a
-a
a)
smootherStep :: a -> a
smootherStep a
x = a
6.0 a -> a -> a
forall a. Num a => a -> a -> a
* a
xa -> a -> a
forall a. Floating a => a -> a -> a
**a
5 a -> a -> a
forall a. Num a => a -> a -> a
- a
15.0 a -> a -> a
forall a. Num a => a -> a -> a
* a
xa -> a -> a
forall a. Floating a => a -> a -> a
**a
4 a -> a -> a
forall a. Num a => a -> a -> a
+ a
10.0 a -> a -> a
forall a. Num a => a -> a -> a
* a
xa -> a -> a
forall a. Floating a => a -> a -> a
**a
3
perlin :: Fractional a => Pattern a
perlin :: forall a. Fractional a => Pattern a
perlin = Pattern Double -> Pattern a
forall a. Fractional a => Pattern Double -> Pattern a
perlinWith ((Rational -> Double) -> Pattern Double
forall a. (Rational -> a) -> Pattern a
sig Rational -> Double
forall a. Fractional a => Rational -> a
fromRational)
perlin2With :: Pattern Double -> Pattern Double -> Pattern Double
perlin2With :: Pattern Double -> Pattern Double -> Pattern Double
perlin2With Pattern Double
x Pattern Double
y = (Pattern Double -> Pattern Double -> Pattern Double
forall a. Fractional a => a -> a -> a
/Pattern Double
2) (Pattern Double -> Pattern Double)
-> (Pattern Double -> Pattern Double)
-> Pattern Double
-> Pattern Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pattern Double -> Pattern Double -> Pattern Double
forall a. Num a => a -> a -> a
+Pattern Double
1) (Pattern Double -> Pattern Double)
-> Pattern Double -> Pattern Double
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double -> Double -> Double -> Double -> Double
forall {a}. Floating a => a -> a -> a -> a -> a -> a -> a
interp2 (Double
-> Double -> Double -> Double -> Double -> Double -> Double)
-> Pattern Double
-> Pattern
(Double -> Double -> Double -> Double -> Double -> Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Double
xfrac Pattern (Double -> Double -> Double -> Double -> Double -> Double)
-> Pattern Double
-> Pattern (Double -> Double -> Double -> Double -> Double)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pattern Double
yfrac Pattern (Double -> Double -> Double -> Double -> Double)
-> Pattern Double -> Pattern (Double -> Double -> Double -> Double)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pattern Double
dota Pattern (Double -> Double -> Double -> Double)
-> Pattern Double -> Pattern (Double -> Double -> Double)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pattern Double
dotb Pattern (Double -> Double -> Double)
-> Pattern Double -> Pattern (Double -> Double)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pattern Double
dotc Pattern (Double -> Double) -> Pattern Double -> Pattern Double
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pattern Double
dotd where
fl :: Pattern Double -> Pattern Double
fl = (Double -> Double) -> Pattern Double -> Pattern Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Double) (Int -> Double) -> (Double -> Int) -> Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor)
ce :: Pattern Double -> Pattern Double
ce = (Double -> Double) -> Pattern Double -> Pattern Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Double) (Int -> Double) -> (Double -> Int) -> Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int -> Int) -> (Double -> Int) -> Double -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor)
xfrac :: Pattern Double
xfrac = Pattern Double
x Pattern Double -> Pattern Double -> Pattern Double
forall a. Num a => a -> a -> a
- Pattern Double -> Pattern Double
fl Pattern Double
x
yfrac :: Pattern Double
yfrac = Pattern Double
y Pattern Double -> Pattern Double -> Pattern Double
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 a -> a -> a
forall a. Num a => a -> a -> a
* a
forall a. Floating a => a
pi a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a b. (RealFrac a, Fractional b) => a -> b
timeToRand (a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
0.0001 a -> a -> a
forall a. Num a => a -> a -> a
* a
b)
pcos :: f a -> f a -> f b
pcos f a
x' f a
y' = f b -> f b
forall {a}. Floating a => a -> a
cos (f b -> f b) -> f b -> f b
forall a b. (a -> b) -> a -> b
$ a -> a -> b
forall {a} {a}. (Floating a, RealFrac a) => a -> a -> a
randAngle (a -> a -> b) -> f a -> f (a -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
x' f (a -> b) -> f a -> f b
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' = f b -> f b
forall {a}. Floating a => a -> a
sin (f b -> f b) -> f b -> f b
forall a b. (a -> b) -> a -> b
$ a -> a -> b
forall {a} {a}. (Floating a, RealFrac a) => a -> a -> a
randAngle (a -> a -> b) -> f a -> f (a -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
x' f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
y'
dota :: Pattern Double
dota = Pattern Double -> Pattern Double -> Pattern Double
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) Pattern Double -> Pattern Double -> Pattern Double
forall a. Num a => a -> a -> a
* Pattern Double
xfrac Pattern Double -> Pattern Double -> Pattern Double
forall a. Num a => a -> a -> a
+ Pattern Double -> Pattern Double -> Pattern Double
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) Pattern Double -> Pattern Double -> Pattern Double
forall a. Num a => a -> a -> a
* Pattern Double
yfrac
dotb :: Pattern Double
dotb = Pattern Double -> Pattern Double -> Pattern Double
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) Pattern Double -> Pattern Double -> Pattern Double
forall a. Num a => a -> a -> a
* (Pattern Double
xfrac Pattern Double -> Pattern Double -> Pattern Double
forall a. Num a => a -> a -> a
- Pattern Double
1) Pattern Double -> Pattern Double -> Pattern Double
forall a. Num a => a -> a -> a
+ Pattern Double -> Pattern Double -> Pattern Double
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) Pattern Double -> Pattern Double -> Pattern Double
forall a. Num a => a -> a -> a
* Pattern Double
yfrac
dotc :: Pattern Double
dotc = Pattern Double -> Pattern Double -> Pattern Double
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) Pattern Double -> Pattern Double -> Pattern Double
forall a. Num a => a -> a -> a
* Pattern Double
xfrac Pattern Double -> Pattern Double -> Pattern Double
forall a. Num a => a -> a -> a
+ Pattern Double -> Pattern Double -> Pattern Double
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) Pattern Double -> Pattern Double -> Pattern Double
forall a. Num a => a -> a -> a
* (Pattern Double
yfrac Pattern Double -> Pattern Double -> Pattern Double
forall a. Num a => a -> a -> a
- Pattern Double
1)
dotd :: Pattern Double
dotd = Pattern Double -> Pattern Double -> Pattern Double
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) Pattern Double -> Pattern Double -> Pattern Double
forall a. Num a => a -> a -> a
* (Pattern Double
xfrac Pattern Double -> Pattern Double -> Pattern Double
forall a. Num a => a -> a -> a
- Pattern Double
1) Pattern Double -> Pattern Double -> Pattern Double
forall a. Num a => a -> a -> a
+ Pattern Double -> Pattern Double -> Pattern Double
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) Pattern Double -> Pattern Double -> Pattern Double
forall a. Num a => a -> a -> a
* (Pattern Double
yfrac Pattern Double -> Pattern Double -> Pattern Double
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 a -> a -> a
forall a. Num a => a -> a -> a
- a -> a
forall {a}. Floating a => a -> a
s a
x') a -> a -> a
forall a. Num a => a -> a -> a
* (a
1.0 a -> a -> a
forall a. Num a => a -> a -> a
- a -> a
forall {a}. Floating a => a -> a
s a
y') a -> a -> a
forall a. Num a => a -> a -> a
* a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall {a}. Floating a => a -> a
s a
x' a -> a -> a
forall a. Num a => a -> a -> a
* (a
1.0 a -> a -> a
forall a. Num a => a -> a -> a
- a -> a
forall {a}. Floating a => a -> a
s a
y') a -> a -> a
forall a. Num a => a -> a -> a
* a
b
a -> a -> a
forall a. Num a => a -> a -> a
+ (a
1.0 a -> a -> a
forall a. Num a => a -> a -> a
- a -> a
forall {a}. Floating a => a -> a
s a
x') a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall {a}. Floating a => a -> a
s a
y' a -> a -> a
forall a. Num a => a -> a -> a
* a
c a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall {a}. Floating a => a -> a
s a
x' a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall {a}. Floating a => a -> a
s a
y' a -> a -> a
forall a. Num a => a -> a -> a
* a
d
s :: a -> a
s a
x' = a
6.0 a -> a -> a
forall a. Num a => a -> a -> a
* a
x'a -> a -> a
forall a. Floating a => a -> a -> a
**a
5 a -> a -> a
forall a. Num a => a -> a -> a
- a
15.0 a -> a -> a
forall a. Num a => a -> a -> a
* a
x'a -> a -> a
forall a. Floating a => a -> a -> a
**a
4 a -> a -> a
forall a. Num a => a -> a -> a
+ a
10.0 a -> a -> a
forall a. Num a => a -> a -> a
* a
x'a -> a -> a
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 ((Rational -> Double) -> Pattern Double
forall a. (Rational -> a) -> Pattern a
sig Rational -> Double
forall a. Fractional a => Rational -> a
fromRational)
choose :: [a] -> Pattern a
choose :: forall a. [a] -> Pattern a
choose = Pattern Double -> [a] -> Pattern a
forall a. Pattern Double -> [a] -> Pattern a
chooseBy Pattern Double
forall a. Fractional a => Pattern a
rand
chooseBy :: Pattern Double -> [a] -> Pattern a
chooseBy :: forall a. Pattern Double -> [a] -> Pattern a
chooseBy Pattern Double
_ [] = Pattern a
forall a. Pattern a
silence
chooseBy Pattern Double
f [a]
xs = ([a]
xs [a] -> Int -> a
forall a. [a] -> Int -> a
!!!) (Int -> a) -> (Double -> Int) -> Double -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> a) -> Pattern Double -> Pattern a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Double
-> Pattern Double -> Pattern Double -> Pattern Double
forall a. Num a => Pattern a -> Pattern a -> Pattern a -> Pattern a
range Pattern Double
0 (Int -> Pattern Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Pattern Double) -> Int -> Pattern Double
forall a b. (a -> b) -> a -> b
$ [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs) Pattern Double
f
wchoose :: [(a,Double)] -> Pattern a
wchoose :: forall a. [(a, Double)] -> Pattern a
wchoose = Pattern Double -> [(a, Double)] -> Pattern a
forall a. Pattern Double -> [(a, Double)] -> Pattern a
wchooseBy Pattern Double
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 (Double -> a) -> Pattern Double -> Pattern a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Double
pat
where
match :: Double -> a
match Double
r = [a]
values [a] -> Int -> a
forall a. [a] -> Int -> a
!! [Int] -> Int
forall a. [a] -> a
head ((Double -> Bool) -> [Double] -> [Int]
forall a. (a -> Bool) -> [a] -> [Int]
findIndices (Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> (Double
rDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
total)) [Double]
cweights)
cweights :: [Double]
cweights = (Double -> Double -> Double) -> [Double] -> [Double]
forall a. (a -> a -> a) -> [a] -> [a]
scanl1 Double -> Double -> Double
forall a. Num a => a -> a -> a
(+) (((a, Double) -> Double) -> [(a, Double)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (a, Double) -> Double
forall a b. (a, b) -> b
snd [(a, Double)]
pairs)
values :: [a]
values = ((a, Double) -> a) -> [(a, Double)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, Double) -> a
forall a b. (a, b) -> a
fst [(a, Double)]
pairs
total :: Double
total = [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ ((a, Double) -> Double) -> [(a, Double)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (a, Double) -> Double
forall a b. (a, b) -> b
snd [(a, Double)]
pairs
degradeBy :: Pattern Double -> Pattern a -> Pattern a
degradeBy :: forall a. Pattern Double -> Pattern a -> Pattern a
degradeBy = (Double -> Pattern a -> Pattern a)
-> Pattern Double -> Pattern a -> Pattern a
forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam Double -> Pattern a -> Pattern a
forall a. Double -> Pattern a -> Pattern a
_degradeBy
_degradeBy :: Double -> Pattern a -> Pattern a
_degradeBy :: forall a. Double -> Pattern a -> Pattern a
_degradeBy = Pattern Double -> Double -> Pattern a -> Pattern a
forall a. Pattern Double -> Double -> Pattern a -> Pattern a
_degradeByUsing Pattern Double
forall a. Fractional a => Pattern a
rand
_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 = ((a, Double) -> a) -> Pattern (a, Double) -> Pattern a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, Double) -> a
forall a b. (a, b) -> a
fst (Pattern (a, Double) -> Pattern a)
-> Pattern (a, Double) -> Pattern a
forall a b. (a -> b) -> a -> b
$ ((a, Double) -> Bool) -> Pattern (a, Double) -> Pattern (a, Double)
forall a. (a -> Bool) -> Pattern a -> Pattern a
filterValues ((Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
x) (Double -> Bool) -> ((a, Double) -> Double) -> (a, Double) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Double) -> Double
forall a b. (a, b) -> b
snd) (Pattern (a, Double) -> Pattern (a, Double))
-> Pattern (a, Double) -> Pattern (a, Double)
forall a b. (a -> b) -> a -> b
$ (,) (a -> Double -> (a, Double))
-> Pattern a -> Pattern (Double -> (a, Double))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
p Pattern (Double -> (a, Double))
-> Pattern Double -> Pattern (a, Double)
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 = (Double -> Pattern a -> Pattern a)
-> Pattern Double -> Pattern a -> Pattern a
forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam Double -> Pattern a -> Pattern a
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 = ((a, Double) -> a) -> Pattern (a, Double) -> Pattern a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, Double) -> a
forall a b. (a, b) -> a
fst (Pattern (a, Double) -> Pattern a)
-> Pattern (a, Double) -> Pattern a
forall a b. (a -> b) -> a -> b
$ ((a, Double) -> Bool) -> Pattern (a, Double) -> Pattern (a, Double)
forall a. (a -> Bool) -> Pattern a -> Pattern a
filterValues ((Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
x) (Double -> Bool) -> ((a, Double) -> Double) -> (a, Double) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Double) -> Double
forall a b. (a, b) -> b
snd) (Pattern (a, Double) -> Pattern (a, Double))
-> Pattern (a, Double) -> Pattern (a, Double)
forall a b. (a -> b) -> a -> b
$ (,) (a -> Double -> (a, Double))
-> Pattern a -> Pattern (Double -> (a, Double))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
p Pattern (Double -> (a, Double))
-> Pattern Double -> Pattern (a, Double)
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
<* Pattern Double
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 = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
unwrap (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ (\Double
x -> ((a, Double) -> a) -> Pattern (a, Double) -> Pattern a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, Double) -> a
forall a b. (a, b) -> a
fst (Pattern (a, Double) -> Pattern a)
-> Pattern (a, Double) -> Pattern a
forall a b. (a -> b) -> a -> b
$ ((a, Double) -> Bool) -> Pattern (a, Double) -> Pattern (a, Double)
forall a. (a -> Bool) -> Pattern a -> Pattern a
filterValues ((Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
x) (Double -> Bool) -> ((a, Double) -> Double) -> (a, Double) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Double) -> Double
forall a b. (a, b) -> b
snd) (Pattern (a, Double) -> Pattern (a, Double))
-> Pattern (a, Double) -> Pattern (a, Double)
forall a b. (a -> b) -> a -> b
$ (,) (a -> Double -> (a, Double))
-> Pattern a -> Pattern (Double -> (a, Double))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
p Pattern (Double -> (a, Double))
-> Pattern Double -> Pattern (a, Double)
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
<* Int -> Pattern Double -> Pattern Double
forall a. Int -> Pattern a -> Pattern a
fastRepeatCycles Int
i Pattern Double
forall a. Fractional a => Pattern a
rand) (Double -> Pattern a) -> Pattern Double -> Pattern (Pattern a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Rational -> Pattern Double -> Pattern Double
forall a. Pattern Rational -> Pattern a -> Pattern a
slow (Int -> Pattern Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i) Pattern Double
tx
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 = Pattern a -> Pattern a -> Pattern a
forall a. Pattern a -> Pattern a -> Pattern a
overlay (Pattern Double -> Pattern a -> Pattern a
forall a. Pattern Double -> Pattern a -> Pattern a
degradeBy Pattern Double
x Pattern a
pat) (Pattern a -> Pattern a
f (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ Pattern Double -> Pattern a -> Pattern a
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 = Pattern a -> Pattern a -> Pattern a
forall a. Pattern a -> Pattern a -> Pattern a
overlay (Pattern Double -> Pattern a -> Pattern a
forall a. Pattern Double -> Pattern a -> Pattern a
degradeBy Pattern Double
x Pattern a
pat) (Pattern Double -> Pattern a -> Pattern a
forall a. Pattern Double -> Pattern a -> Pattern a
unDegradeBy Pattern Double
x (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ Pattern a -> Pattern a
f Pattern a
pat)
sometimes :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
sometimes :: forall a. (Pattern a -> Pattern a) -> Pattern a -> Pattern a
sometimes = Pattern Double
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
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' = Pattern Double
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a.
Pattern Double
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
sometimesBy' Pattern Double
0.5
often :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
often :: forall a. (Pattern a -> Pattern a) -> Pattern a -> Pattern a
often = Pattern Double
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
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' = Pattern Double
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a.
Pattern Double
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
sometimesBy' Pattern Double
0.75
rarely :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
rarely :: forall a. (Pattern a -> Pattern a) -> Pattern a -> Pattern a
rarely = Pattern Double
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
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' = Pattern Double
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a.
Pattern Double
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
sometimesBy' Pattern Double
0.25
almostNever :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
almostNever :: forall a. (Pattern a -> Pattern a) -> Pattern a -> Pattern a
almostNever = Pattern Double
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
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' = Pattern Double
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a.
Pattern Double
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
sometimesBy Pattern Double
0.1
almostAlways :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
almostAlways :: forall a. (Pattern a -> Pattern a) -> Pattern a -> Pattern a
almostAlways = Pattern Double
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
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' = Pattern Double
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
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 = (Pattern a -> (Pattern a -> Pattern a) -> Pattern a)
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Pattern a -> (Pattern a -> Pattern a) -> Pattern a
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 = (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a. a -> a
id
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 = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
innerJoin (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ (\Double
d -> Double -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a.
Double -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_someCyclesBy Double
d Pattern a -> Pattern a
f Pattern a
pat) (Double -> Pattern a) -> Pattern Double -> Pattern (Pattern a)
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 = (Int -> Bool) -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a.
(Int -> Bool) -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
when Int -> Bool
forall {a}. Integral a => a -> Bool
test
where test :: a -> Bool
test a
c = Double -> Double
forall a b. (RealFrac a, Fractional b) => a -> b
timeToRand (a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
c :: Double) Double -> Double -> Bool
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 = Pattern Double
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
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 = Pattern Double
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
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 = (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a. (Pattern a -> Pattern a) -> Pattern a -> Pattern a
someCycles
degrade :: Pattern a -> Pattern a
degrade :: forall a. Pattern a -> Pattern a
degrade = Double -> Pattern a -> Pattern a
forall a. Double -> Pattern a -> Pattern a
_degradeBy Double
0.5
brak :: Pattern a -> Pattern a
brak :: forall a. Pattern a -> Pattern a
brak = (Int -> Bool) -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a.
(Int -> Bool) -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
when ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) (Int -> Bool) -> (Int -> Int) -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2)) (((Integer
1Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
4) Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
`rotR`) (Pattern a -> Pattern a)
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Pattern a
x -> [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
fastcat [Pattern a
x, Pattern a
forall a. Pattern a
silence]))
iter :: Pattern Int -> Pattern c -> Pattern c
iter :: forall c. Pattern Int -> Pattern c -> Pattern c
iter = (Int -> Pattern c -> Pattern c)
-> Pattern Int -> Pattern c -> Pattern c
forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam Int -> Pattern c -> Pattern c
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 = [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
slowcat ([Pattern a] -> Pattern a) -> [Pattern a] -> Pattern a
forall a b. (a -> b) -> a -> b
$ (Int -> Pattern a) -> [Int] -> [Pattern a]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
`rotL` Pattern a
p) [Int
0 .. (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)]
iter' :: Pattern Int -> Pattern c -> Pattern c
iter' :: forall c. Pattern Int -> Pattern c -> Pattern c
iter' = (Int -> Pattern c -> Pattern c)
-> Pattern Int -> Pattern c -> Pattern c
forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam Int -> Pattern c -> Pattern c
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 = [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
slowcat ([Pattern a] -> Pattern a) -> [Pattern a] -> Pattern a
forall a b. (a -> b) -> a -> b
$ (Int -> Pattern a) -> [Int] -> [Pattern a]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
`rotR` Pattern a
p) [Int
0 .. (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)]
palindrome :: Pattern a -> Pattern a
palindrome :: forall a. Pattern a -> Pattern a
palindrome Pattern a
p = Pattern a -> Pattern a -> Pattern a
forall a. Pattern a -> Pattern a -> Pattern a
slowAppend Pattern a
p (Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
rev Pattern a
p)
seqP :: [(Time, Time, Pattern a)] -> Pattern a
seqP :: forall a. [(Rational, Rational, Pattern a)] -> Pattern a
seqP [(Rational, Rational, Pattern a)]
ps = [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
stack ([Pattern a] -> Pattern a) -> [Pattern a] -> Pattern a
forall a b. (a -> b) -> a -> b
$ ((Rational, Rational, Pattern a) -> Pattern a)
-> [(Rational, Rational, Pattern a)] -> [Pattern a]
forall a b. (a -> b) -> [a] -> [b]
map (\(Rational
s, Rational
e, Pattern a
p) -> Rational -> Rational -> Pattern a -> Pattern a
forall a. Rational -> Rational -> Pattern a -> Pattern a
playFor Rational
s Rational
e (Rational -> Rational
sam Rational
s Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
`rotR` Pattern a
p)) [(Rational, Rational, Pattern a)]
ps
fadeOut :: Time -> Pattern a -> Pattern a
fadeOut :: forall a. Rational -> Pattern a -> Pattern a
fadeOut Rational
dur Pattern a
p = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
innerJoin (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ (Double -> Pattern a -> Pattern a
forall a. Double -> Pattern a -> Pattern a
`_degradeBy` Pattern a
p) (Double -> Pattern a) -> Pattern Double -> Pattern (Pattern a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rational -> Pattern Double -> Pattern Double
forall a. Rational -> Pattern a -> Pattern a
_slow Rational
dur Pattern Double
envL
fadeOutFrom :: Time -> Time -> Pattern a -> Pattern a
fadeOutFrom :: forall a. Rational -> Rational -> Pattern a -> Pattern a
fadeOutFrom Rational
from Rational
dur Pattern a
p = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
innerJoin (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ (Double -> Pattern a -> Pattern a
forall a. Double -> Pattern a -> Pattern a
`_degradeBy` Pattern a
p) (Double -> Pattern a) -> Pattern Double -> Pattern (Pattern a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Rational
from Rational -> Pattern Double -> Pattern Double
forall a. Rational -> Pattern a -> Pattern a
`rotR` Rational -> Pattern Double -> Pattern Double
forall a. Rational -> Pattern a -> Pattern a
_slow Rational
dur Pattern Double
envL)
fadeIn :: Time -> Pattern a -> Pattern a
fadeIn :: forall a. Rational -> Pattern a -> Pattern a
fadeIn Rational
dur Pattern a
p = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
innerJoin (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ (Double -> Pattern a -> Pattern a
forall a. Double -> Pattern a -> Pattern a
`_degradeBy` Pattern a
p) (Double -> Pattern a) -> Pattern Double -> Pattern (Pattern a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rational -> Pattern Double -> Pattern Double
forall a. Rational -> Pattern a -> Pattern a
_slow Rational
dur Pattern Double
envLR
fadeInFrom :: Time -> Time -> Pattern a -> Pattern a
fadeInFrom :: forall a. Rational -> Rational -> Pattern a -> Pattern a
fadeInFrom Rational
from Rational
dur Pattern a
p = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
innerJoin (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ (Double -> Pattern a -> Pattern a
forall a. Double -> Pattern a -> Pattern a
`_degradeBy` Pattern a
p) (Double -> Pattern a) -> Pattern Double -> Pattern (Pattern a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Rational
from Rational -> Pattern Double -> Pattern Double
forall a. Rational -> Pattern a -> Pattern a
`rotR` Rational -> Pattern Double -> Pattern Double
forall a. Rational -> Pattern a -> Pattern a
_slow Rational
dur Pattern Double
envLR)
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 = [Pattern b] -> Pattern b
forall a. [Pattern a] -> Pattern a
slowcat ([Pattern b] -> Pattern b) -> [Pattern b] -> Pattern b
forall a b. (a -> b) -> a -> b
$ (a -> Pattern b) -> [a] -> [Pattern 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 = (a -> t -> Pattern b) -> [a] -> t -> Pattern b
forall a t b. (a -> t -> Pattern b) -> [a] -> t -> Pattern b
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 = [Pattern b] -> Pattern b
forall a. [Pattern a] -> Pattern a
fastcat ([Pattern b] -> Pattern b) -> [Pattern b] -> Pattern b
forall a b. (a -> b) -> a -> b
$ (a -> Pattern b) -> [a] -> [Pattern b]
forall a b. (a -> b) -> [a] -> [b]
map (a -> t -> Pattern b
`f` t
p) [a]
xs
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 m a -> (a -> m c) -> m c
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 :: (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 <- Rational -> Pattern t -> Pattern t
forall a. Rational -> Pattern a -> Pattern a
_segment Rational
1 ([t] -> Pattern t
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 = (t -> t1 -> Pattern b) -> [t] -> t1 -> Pattern b
forall a t b. (a -> t -> Pattern b) -> [a] -> t -> Pattern b
spreadChoose
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 = Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
splitQueries (Pattern a -> Pattern a) -> Pattern a -> Pattern a
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 (Rational -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational -> Int) -> Rational -> Int
forall a b. (a -> b) -> a -> b
$ Arc -> Rational
forall a. ArcF a -> a
start (Arc -> Rational) -> Arc -> Rational
forall a b. (a -> b) -> a -> b
$ State -> Arc
arc State
a) = Pattern a -> State -> [Event a]
forall a. Pattern a -> State -> [Event a]
query (Pattern a -> Pattern a
f1 Pattern a
p) State
a
| Bool
otherwise = Pattern a -> State -> [Event a]
forall a. Pattern a -> State -> [Event a]
query (Pattern a -> Pattern a
f2 Pattern a
p) State
a
wedge :: Pattern Time -> Pattern a -> Pattern a -> Pattern a
wedge :: forall a. Pattern Rational -> Pattern a -> Pattern a -> Pattern a
wedge Pattern Rational
pt Pattern a
pa Pattern a
pb = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
innerJoin (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ (\Rational
t -> Rational -> Pattern a -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a -> Pattern a
_wedge Rational
t Pattern a
pa Pattern a
pb) (Rational -> Pattern a) -> Pattern Rational -> Pattern (Pattern a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Rational
pt
_wedge :: Time -> Pattern a -> Pattern a -> Pattern a
_wedge :: forall a. Rational -> Pattern a -> Pattern a -> Pattern a
_wedge Rational
0 Pattern a
_ Pattern a
p' = Pattern a
p'
_wedge Rational
1 Pattern a
p Pattern a
_ = Pattern a
p
_wedge Rational
t Pattern a
p Pattern a
p' = Pattern a -> Pattern a -> Pattern a
forall a. Pattern a -> Pattern a -> Pattern a
overlay (Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
_fastGap (Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
t) Pattern a
p) (Rational
t Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
`rotR` Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
_fastGap (Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/(Rational
1Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
t)) Pattern a
p')
whenmod :: Pattern Time -> Pattern Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
whenmod :: forall a.
Pattern Rational
-> Pattern Rational
-> (Pattern a -> Pattern a)
-> Pattern a
-> Pattern a
whenmod Pattern Rational
a Pattern Rational
b Pattern a -> Pattern a
f Pattern a
pat = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
innerJoin (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ (\Rational
a' Rational
b' -> Rational
-> Rational -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a.
Rational
-> Rational -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_whenmod Rational
a' Rational
b' Pattern a -> Pattern a
f Pattern a
pat) (Rational -> Rational -> Pattern a)
-> Pattern Rational -> Pattern (Rational -> Pattern a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Rational
a Pattern (Rational -> Pattern a)
-> Pattern Rational -> Pattern (Pattern a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pattern Rational
b
_whenmod :: Time -> Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_whenmod :: forall a.
Rational
-> Rational -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_whenmod Rational
a Rational
b = (Rational -> Bool)
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a.
(Rational -> Bool)
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
whenT (\Rational
t -> ((Rational
t Rational -> Rational -> Rational
forall a. Real a => a -> a -> a
`mod'` Rational
a) Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>= Rational
b ))
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 = [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
stack [Pattern a
p, Pattern a -> Pattern a
f Pattern a
p]
trunc :: Pattern Time -> Pattern a -> Pattern a
trunc :: forall a. Pattern Rational -> Pattern a -> Pattern a
trunc = (Rational -> Pattern a -> Pattern a)
-> Pattern Rational -> Pattern a -> Pattern a
forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
_trunc
_trunc :: Time -> Pattern a -> Pattern a
_trunc :: forall a. Rational -> Pattern a -> Pattern a
_trunc Rational
t = (Rational, Rational) -> Pattern a -> Pattern a
forall a. (Rational, Rational) -> Pattern a -> Pattern a
compress (Rational
0, Rational
t) (Pattern a -> Pattern a)
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arc -> Pattern a -> Pattern a
forall a. Arc -> Pattern a -> Pattern a
zoomArc (Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc Rational
0 Rational
t)
linger :: Pattern Time -> Pattern a -> Pattern a
linger :: forall a. Pattern Rational -> Pattern a -> Pattern a
linger = (Rational -> Pattern a -> Pattern a)
-> Pattern Rational -> Pattern a -> Pattern a
forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
_linger
_linger :: Time -> Pattern a -> Pattern a
_linger :: forall a. Rational -> Pattern a -> Pattern a
_linger Rational
n Pattern a
p | Rational
n Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
0 = Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
_fast (Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
n) (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ Arc -> Pattern a -> Pattern a
forall a. Arc -> Pattern a -> Pattern a
zoomArc (Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc (Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
n) Rational
1) Pattern a
p
| Bool
otherwise = Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
_fast (Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
n) (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ Arc -> Pattern a -> Pattern a
forall a. Arc -> Pattern a -> Pattern a
zoomArc (Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc Rational
0 Rational
n) Pattern a
p
within :: (Time, Time) -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
within :: forall a.
(Rational, Rational)
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
within (Rational
s, Rational
e) Pattern a -> Pattern a
f Pattern a
p = [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
stack [(Rational -> Bool) -> Pattern a -> Pattern a
forall a. (Rational -> Bool) -> Pattern a -> Pattern a
filterWhen (\Rational
t -> Rational -> Rational
cyclePos Rational
t Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>= Rational
s Bool -> Bool -> Bool
&& Rational -> Rational
cyclePos Rational
t Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
e) (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ Pattern a -> Pattern a
f Pattern a
p,
(Rational -> Bool) -> Pattern a -> Pattern a
forall a. (Rational -> Bool) -> Pattern a -> Pattern a
filterWhen (\Rational
t -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Rational -> Rational
cyclePos Rational
t Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>= Rational
s Bool -> Bool -> Bool
&& Rational -> Rational
cyclePos Rational
t Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
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 Rational
s Rational
e) = (Rational, Rational)
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a.
(Rational, Rational)
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
within (Rational
s, Rational
e)
within' :: (Time, Time) -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
within' :: forall a.
(Rational, Rational)
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
within' a :: (Rational, Rational)
a@(Rational
s, Rational
e) Pattern a -> Pattern a
f Pattern a
p =
[Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
stack [ (Rational -> Bool) -> Pattern a -> Pattern a
forall a. (Rational -> Bool) -> Pattern a -> Pattern a
filterWhen (\Rational
t -> Rational -> Rational
cyclePos Rational
t Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>= Rational
s Bool -> Bool -> Bool
&& Rational -> Rational
cyclePos Rational
t Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
e) (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ (Rational, Rational) -> Pattern a -> Pattern a
forall a. (Rational, Rational) -> Pattern a -> Pattern a
compress (Rational, Rational)
a (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ Pattern a -> Pattern a
f (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ (Rational, Rational) -> Pattern a -> Pattern a
forall a. (Rational, Rational) -> Pattern a -> Pattern a
zoom (Rational, Rational)
a Pattern a
p
, (Rational -> Bool) -> Pattern a -> Pattern a
forall a. (Rational -> Bool) -> Pattern a -> Pattern a
filterWhen (\Rational
t -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Rational -> Rational
cyclePos Rational
t Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>= Rational
s Bool -> Bool -> Bool
&& Rational -> Rational
cyclePos Rational
t Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
e) Pattern a
p
]
revArc :: (Time, Time) -> Pattern a -> Pattern a
revArc :: forall a. (Rational, Rational) -> Pattern a -> Pattern a
revArc (Rational, Rational)
a = (Rational, Rational)
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a.
(Rational, Rational)
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
within (Rational, Rational)
a Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
rev
euclid :: Pattern Int -> Pattern Int -> Pattern a -> Pattern a
euclid :: forall a. Pattern Int -> Pattern Int -> Pattern a -> Pattern a
euclid = (Int -> Int -> Pattern a -> Pattern a)
-> Pattern Int -> Pattern Int -> Pattern a -> Pattern a
forall a b c d.
(a -> b -> c -> Pattern d)
-> Pattern a -> Pattern b -> c -> Pattern d
tParam2 Int -> Int -> Pattern a -> Pattern a
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 = [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
fastcat ([Pattern a] -> Pattern a) -> [Pattern a] -> Pattern a
forall a b. (a -> b) -> a -> b
$ (Bool -> Pattern a) -> [Bool] -> [Pattern a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Pattern a -> Pattern a -> Bool -> Pattern a
forall a. a -> a -> Bool -> a
bool Pattern a
forall a. Pattern a
silence Pattern a
a) ([Bool] -> [Pattern a]) -> [Bool] -> [Pattern a]
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> [Bool]
bjorklund (Int
n,Int
k)
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 = [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
stack [ Pattern Int -> Pattern Int -> Pattern a -> Pattern a
forall a. Pattern Int -> Pattern Int -> Pattern a -> Pattern a
euclid Pattern Int
n Pattern Int
k Pattern a
pa, Pattern Int -> Pattern Int -> Pattern a -> Pattern a
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 = [Bool] -> Pattern Bool
forall a. [a] -> Pattern a
fastFromList ([Bool] -> Pattern Bool) -> [Bool] -> Pattern Bool
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 = [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
fastcat ([Pattern a] -> Pattern a) -> [Pattern a] -> Pattern a
forall a b. (a -> b) -> a -> b
$ (Bool -> Pattern a) -> [Bool] -> [Pattern a]
forall a b. (a -> b) -> [a] -> [b]
map (\Bool
x -> if Bool
x then Pattern a
p else Pattern a
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 = (Int -> Int -> Int -> Pattern a -> Pattern a)
-> Pattern Int
-> Pattern Int
-> Pattern Int
-> Pattern a
-> Pattern a
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 a -> Pattern a
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 = Pattern Int -> Pattern Int -> Pattern Int -> Pattern a -> Pattern a
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
_ = Pattern a
forall a. Pattern a
silence
_euclidOff Int
n Int
k Int
s Pattern a
p = (Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
rotL (Rational -> Pattern a -> Pattern a)
-> Rational -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sInteger -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k) (Int -> Int -> Pattern a -> Pattern a
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 = (Int -> Int -> Int -> Pattern Bool -> Pattern Bool)
-> Pattern Int
-> Pattern Int
-> Pattern Int
-> Pattern Bool
-> Pattern Bool
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
_ = Pattern Bool
forall a. Pattern a
silence
_euclidOffBool Int
n Int
k Int
s Pattern Bool
p = ((Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k) Rational -> Pattern Bool -> Pattern Bool
forall a. Rational -> Pattern a -> Pattern a
`rotL`) ((\Bool
a Bool
b -> if Bool
b then Bool
a else Bool -> Bool
not Bool
a) (Bool -> Bool -> Bool) -> Pattern Bool -> Pattern (Bool -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> Pattern Bool
_euclidBool Int
n Int
k Pattern (Bool -> Bool) -> Pattern Bool -> Pattern Bool
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' <- [Pattern Int] -> Pattern [Int]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Pattern Int]
ps
[Int] -> Pattern a -> Pattern a
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 = [Bool] -> Pattern a -> Pattern a
forall {b}. [Bool] -> Pattern b -> Pattern b
boolsToPat (([Bool] -> [Bool] -> [Bool]) -> [Bool] -> [[Bool]] -> [Bool]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [Bool] -> [Bool] -> [Bool]
distrib' (Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate ([Int] -> Int
forall a. [a] -> a
last [Int]
xs) Bool
True) ([[Bool]] -> [[Bool]]
forall a. [a] -> [a]
reverse ([[Bool]] -> [[Bool]]) -> [[Bool]] -> [[Bool]]
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 Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: [Bool] -> [Bool] -> [Bool]
distrib' [Bool]
a []
distrib' (Bool
True:[Bool]
a) (Bool
x:[Bool]
b) = Bool
x Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: [Bool] -> [Bool] -> [Bool]
distrib' [Bool]
a [Bool]
b
distrib' (Bool
False:[Bool]
a) [Bool]
b = Bool
False Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: [Bool] -> [Bool] -> [Bool]
distrib' [Bool]
a [Bool]
b
layers :: [Int] -> [[Bool]]
layers = ((Int, Int) -> [Bool]) -> [(Int, Int)] -> [[Bool]]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> [Bool]
bjorklund ([(Int, Int)] -> [[Bool]])
-> ([Int] -> [(Int, Int)]) -> [Int] -> [[Bool]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip([Int] -> [Int] -> [(Int, Int)])
-> ([Int] -> [Int]) -> [Int] -> [(Int, Int)]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>[Int] -> [Int]
forall a. [a] -> [a]
tail)
boolsToPat :: [Bool] -> Pattern b -> Pattern b
boolsToPat [Bool]
a Pattern b
b' = (b -> Bool -> b) -> Bool -> b -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> Bool -> b
forall a b. a -> b -> a
const (Bool -> b -> b) -> Pattern Bool -> Pattern (b -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> Bool) -> Pattern Bool -> Pattern Bool
forall a. (a -> Bool) -> Pattern a -> Pattern a
filterValues (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
True) ([Bool] -> Pattern Bool
forall a. [a] -> Pattern a
fastFromList [Bool]
a) Pattern (b -> b) -> Pattern b -> Pattern b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pattern b
b'
euclidInv :: Pattern Int -> Pattern Int -> Pattern a -> Pattern a
euclidInv :: forall a. Pattern Int -> Pattern Int -> Pattern a -> Pattern a
euclidInv = (Int -> Int -> Pattern a -> Pattern a)
-> Pattern Int -> Pattern Int -> Pattern a -> Pattern a
forall a b c d.
(a -> b -> c -> Pattern d)
-> Pattern a -> Pattern b -> c -> Pattern d
tParam2 Int -> Int -> Pattern a -> Pattern a
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 = [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
fastcat ([Pattern a] -> Pattern a) -> [Pattern a] -> Pattern a
forall a b. (a -> b) -> a -> b
$ (Bool -> Pattern a) -> [Bool] -> [Pattern a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Pattern a -> Pattern a -> Bool -> Pattern a
forall a. a -> a -> Bool -> a
bool Pattern a
a Pattern a
forall a. Pattern a
silence) ([Bool] -> [Pattern a]) -> [Bool] -> [Pattern a]
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> [Bool]
bjorklund (Int
n,Int
k)
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 =
(Rational -> Pattern c -> Pattern c)
-> Pattern Rational -> Pattern c -> Pattern c
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> m c) -> m a -> b -> m c
spread' (Rational -> Rational -> Pattern c -> Pattern c
forall a. Rational -> Rational -> Pattern a -> Pattern a
zoom' (Rational -> Rational -> Pattern c -> Pattern c)
-> Rational -> Rational -> Pattern c -> Pattern c
forall a b. (a -> b) -> a -> b
$ b -> Rational
forall a. Real a => a -> Rational
toRational b
sz) (b -> Rational
forall a. Real a => a -> Rational
toRational (b -> Rational) -> (b -> b) -> b -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> b -> b
forall a. Num a => a -> a -> a
*(b
1b -> b -> b
forall a. Num a => a -> a -> a
-b
sz)) (b -> Rational) -> Pattern b -> Pattern Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern b
indexpat) Pattern c
pat
where
zoom' :: Rational -> Rational -> Pattern a -> Pattern a
zoom' Rational
tSz Rational
s = Arc -> Pattern a -> Pattern a
forall a. Arc -> Pattern a -> Pattern a
zoomArc (Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc Rational
s (Rational
sRational -> Rational -> Rational
forall a. Num a => a -> a -> a
+Rational
tSz))
rot :: Ord a => Pattern Int -> Pattern a -> Pattern a
rot :: forall a. Ord a => Pattern Int -> Pattern a -> Pattern a
rot = (Int -> Pattern a -> Pattern a)
-> Pattern Int -> Pattern a -> Pattern a
forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam Int -> Pattern a -> Pattern a
forall a. Ord a => Int -> Pattern a -> Pattern a
_rot
_rot :: Ord a => Int -> Pattern a -> Pattern a
_rot :: forall a. Ord a => Int -> Pattern a -> Pattern a
_rot Int
i Pattern a
pat = Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
splitQueries (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ Pattern a
pat {query :: State -> [Event a]
query = \State
st -> State -> [Event a] -> [Event a]
forall {a}. Ord a => State -> [Event a] -> [Event a]
f State
st (Pattern a -> State -> [Event a]
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
f :: State -> [Event a] -> [Event a]
f State
st [Event a]
es = Arc -> [Event a] -> [Event a]
forall a. Arc -> [Event a] -> [Event a]
constrainEvents (State -> Arc
arc State
st) ([Event a] -> [Event a]) -> [Event a] -> [Event a]
forall a b. (a -> b) -> a -> b
$ [Event a] -> [Event a]
forall {a} {b}. [EventF a b] -> [EventF a b]
shiftValues ([Event a] -> [Event a]) -> [Event a] -> [Event a]
forall a b. (a -> b) -> a -> b
$ [Event a] -> [Event a]
forall a. Ord a => [a] -> [a]
sort ([Event a] -> [Event a]) -> [Event a] -> [Event a]
forall a b. (a -> b) -> a -> b
$ [Event a] -> [Event a]
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 =
(EventF a b -> b -> EventF a b)
-> [EventF a b] -> [b] -> [EventF a b]
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
(Int -> [b] -> [b]
forall a. Int -> [a] -> [a]
drop Int
i ([b] -> [b]) -> [b] -> [b]
forall a b. (a -> b) -> a -> b
$ [b] -> [b]
forall a. [a] -> [a]
cycle ([b] -> [b]) -> [b] -> [b]
forall a b. (a -> b) -> a -> b
$ (EventF a b -> b) -> [EventF a b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map EventF a b -> b
forall a b. EventF a b -> b
value [EventF a b]
es)
| Bool
otherwise =
(EventF a b -> b -> EventF a b)
-> [EventF a b] -> [b] -> [EventF a b]
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
(Int -> [b] -> [b]
forall a. Int -> [a] -> [a]
drop ([EventF a b] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [EventF a b]
es Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Int
forall a. Num a => a -> a
abs Int
i) ([b] -> [b]) -> [b] -> [b]
forall a b. (a -> b) -> a -> b
$ [b] -> [b]
forall a. [a] -> [a]
cycle ([b] -> [b]) -> [b] -> [b]
forall a b. (a -> b) -> a -> b
$ (EventF a b -> b) -> [EventF a b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map EventF a b -> b
forall a b. EventF a b -> b
value [EventF a b]
es)
wholeCycle :: Arc -> Arc
wholeCycle (Arc Rational
s Rational
_) = Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc (Rational -> Rational
sam Rational
s) (Rational -> Rational
nextSam Rational
s)
constrainEvents :: Arc -> [Event a] -> [Event a]
constrainEvents :: forall a. Arc -> [Event a] -> [Event a]
constrainEvents Arc
a [Event a]
es = (Event a -> Maybe (Event a)) -> [Event a] -> [Event a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Arc -> Event a -> Maybe (Event a)
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 (Event a -> Arc
forall a b. EventF a b -> a
part Event a
e) Arc
a
Event a -> Maybe (Event a)
forall (m :: * -> *) a. Monad m => a -> m a
return Event a
e {part :: Arc
part = Arc
p'}
segment :: Pattern Time -> Pattern a -> Pattern a
segment :: forall a. Pattern Rational -> Pattern a -> Pattern a
segment = (Rational -> Pattern a -> Pattern a)
-> Pattern Rational -> Pattern a -> Pattern a
forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
_segment
_segment :: Time -> Pattern a -> Pattern a
_segment :: forall a. Rational -> Pattern a -> Pattern a
_segment Rational
n Pattern a
p = Rational -> Pattern (a -> a) -> Pattern (a -> a)
forall a. Rational -> Pattern a -> Pattern a
_fast Rational
n ((a -> a) -> Pattern (a -> a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> a
forall a. a -> a
id) Pattern (a -> a) -> Pattern a -> Pattern a
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
<* Pattern a
p
discretise :: Pattern Time -> Pattern a -> Pattern a
discretise :: forall a. Pattern Rational -> Pattern a -> Pattern a
discretise = Pattern Rational -> Pattern a -> Pattern a
forall a. Pattern Rational -> Pattern a -> Pattern a
segment
randcat :: [Pattern a] -> Pattern a
randcat :: forall a. [Pattern a] -> Pattern a
randcat [Pattern a]
ps = (Rational -> Pattern a -> Pattern a)
-> Pattern Rational -> Pattern a -> Pattern a
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> m c) -> m a -> b -> m c
spread' Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
rotL (Rational -> Pattern Rational -> Pattern Rational
forall a. Rational -> Pattern a -> Pattern a
_segment Rational
1 (Pattern Rational -> Pattern Rational)
-> Pattern Rational -> Pattern Rational
forall a b. (a -> b) -> a -> b
$ (Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
1) (Integer -> Rational) -> (Int -> Integer) -> Int -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Rational) -> Pattern Int -> Pattern Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Pattern Int
forall a. Num a => Int -> Pattern a
_irand ([Pattern a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pattern a]
ps) :: Pattern Int)) ([Pattern a] -> Pattern a
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 = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
unwrap (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ Pattern Double -> [(Pattern a, Double)] -> Pattern (Pattern a)
forall a. Pattern Double -> [(a, Double)] -> Pattern a
wchooseBy (Pattern Rational -> Pattern Double -> Pattern Double
forall a. Pattern Rational -> Pattern a -> Pattern a
segment Pattern Rational
1 Pattern Double
forall a. Fractional a => Pattern a
rand) [(Pattern a, Double)]
ps
_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 [a] -> Int -> a
forall a. [a] -> Int -> a
!!!) (Int -> a) -> Pattern Int -> Pattern a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Pattern Int
p {query :: State -> [Event Int]
query = (Event Int -> Event Int) -> [Event Int] -> [Event Int]
forall a b. (a -> b) -> [a] -> [b]
map (\Event Int
e -> (Int -> Int) -> Event Int -> Event Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Event Int -> Int
forall {a} {b}. RealFrac a => EventF (ArcF a) b -> Int
pos Event Int
e) Event Int
e) ([Event Int] -> [Event Int])
-> (State -> [Event Int]) -> State -> [Event Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern Int -> State -> [Event Int]
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (ArcF a -> a
forall a. ArcF a -> a
start (ArcF a -> a) -> ArcF a -> a
forall a b. (a -> b) -> a -> b
$ EventF (ArcF a) b -> ArcF a
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 = ((Int -> ([a], Pattern Int) -> Pattern a)
-> Pattern Int -> ([a], Pattern Int) -> Pattern a
forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam Int -> ([a], Pattern Int) -> Pattern a
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') = Int -> [a] -> Pattern Int -> Pattern a
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 = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
unwrap (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ (\b
n -> [a] -> Pattern a
forall a. [a] -> Pattern a
fastFromList ([a] -> Pattern a) -> [a] -> Pattern a
forall a b. (a -> b) -> a -> b
$ ((Int, a) -> [a]) -> [(Int, a)] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Int, a)
x -> Int -> a -> [a]
forall a. Int -> a -> [a]
replicate ((Int, a) -> Int
forall a b. (a, b) -> a
fst (Int, a)
x) ((Int, a) -> a
forall a b. (a, b) -> b
snd (Int, a)
x)) ([(Int, a)] -> [a]) -> [(Int, a)] -> [a]
forall a b. (a -> b) -> a -> b
$ [Int] -> [a] -> [(Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([[Int]]
ps [[Int]] -> Int -> [Int]
forall a. [a] -> Int -> a
!! b -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (b
n b -> b -> b
forall a. Num a => a -> a -> a
* Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([[Int]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Int]]
ps Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))) [a]
things) (b -> Pattern a) -> Pattern b -> Pattern (Pattern a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rational -> Pattern b -> Pattern b
forall a. Rational -> Pattern a -> Pattern a
_segment Rational
1 Pattern b
p
where ps :: [[Int]]
ps = Int -> Int -> [[Int]]
forall {a}. Integral a => a -> a -> [[a]]
permsort ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
things) Int
nSteps
deviance :: a -> [a] -> a
deviance a
avg [a]
xs = [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> a
forall a. Num a => a -> a
abs (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
avga -> a -> a
forall a. Num a => a -> a -> a
-) (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral) [a]
xs
permsort :: a -> a -> [[a]]
permsort a
n a
total = (([a], Double) -> [a]) -> [([a], Double)] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map ([a], Double) -> [a]
forall a b. (a, b) -> a
fst ([([a], Double)] -> [[a]]) -> [([a], Double)] -> [[a]]
forall a b. (a -> b) -> a -> b
$ (([a], Double) -> Double) -> [([a], Double)] -> [([a], Double)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn ([a], Double) -> Double
forall a b. (a, b) -> b
snd ([([a], Double)] -> [([a], Double)])
-> [([a], Double)] -> [([a], Double)]
forall a b. (a -> b) -> a -> b
$ ([a] -> ([a], Double)) -> [[a]] -> [([a], Double)]
forall a b. (a -> b) -> [a] -> [b]
map (\[a]
x -> ([a]
x,Double -> [a] -> Double
forall {a} {a}. (Integral a, Num a) => a -> [a] -> a
deviance (a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
total Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n :: Double)) [a]
x)) ([[a]] -> [([a], Double)]) -> [[a]] -> [([a], Double)]
forall a b. (a -> b) -> a -> b
$ a -> a -> [[a]]
forall {a}. (Eq a, Num a, Enum a) => a -> a -> [[a]]
perms a
n a
total
perms :: a -> a -> [[a]]
perms a
0 a
_ = []
perms a
1 a
n = [[a
n]]
perms a
n a
total = (a -> [[a]]) -> [a] -> [[a]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\a
x -> ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ a -> a -> [[a]]
perms (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
1) (a
totala -> a -> a
forall a. Num a => a -> a -> a
-a
x)) [a
1 .. (a
totala -> a -> a
forall a. Num a => a -> a -> a
-(a
na -> a -> a
forall a. Num a => a -> a -> a
-a
1))]
struct :: Pattern Bool -> Pattern a -> Pattern a
struct :: forall a. Pattern Bool -> Pattern a -> Pattern a
struct Pattern Bool
ps Pattern a
pv = Pattern (Maybe a) -> Pattern a
forall a. Pattern (Maybe a) -> Pattern a
filterJust (Pattern (Maybe a) -> Pattern a) -> Pattern (Maybe a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ (\Bool
a a
b -> if Bool
a then a -> Maybe a
forall a. a -> Maybe a
Just a
b else Maybe a
forall a. Maybe a
Nothing ) (Bool -> a -> Maybe a) -> Pattern Bool -> Pattern (a -> Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Bool
ps Pattern (a -> Maybe a) -> Pattern a -> Pattern (Maybe a)
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
<* Pattern a
pv
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 =
(Event Bool -> [Event b]) -> [Event Bool] -> [Event b]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((\Arc
a' -> Pattern b -> Arc -> [Event b]
forall a. Pattern a -> Arc -> [Event a]
queryArc (Arc -> Pattern b -> Pattern b
forall a. Arc -> Pattern a -> Pattern a
compressArcTo Arc
a' Pattern b
p) Arc
a') (Arc -> [Event b])
-> (Event Bool -> Arc) -> Event Bool -> [Event b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event Bool -> Arc
forall a. Event a -> Arc
wholeOrPart) ([Event Bool] -> [Event b]) -> [Event Bool] -> [Event b]
forall a b. (a -> b) -> a -> b
$ (Event Bool -> Bool) -> [Event Bool] -> [Event Bool]
forall a. (a -> Bool) -> [a] -> [a]
filter Event Bool -> Bool
forall a b. EventF a b -> b
value ([Event Bool] -> [Event Bool]) -> [Event Bool] -> [Event Bool]
forall a b. (a -> b) -> a -> b
$ Pattern Bool -> State -> [Event Bool]
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 <- (Int -> Pattern Int) -> [Int] -> Pattern [Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Int
x -> Rational -> Pattern Rational
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Rational
forall a. Real a => a -> Rational
toRational Int
x Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Int -> Rational
forall a. Real a => a -> Rational
toRational Int
n) Pattern Rational -> Pattern Int -> Pattern Int
forall a. Pattern Rational -> Pattern a -> Pattern a
<~ [Int] -> Pattern Int
forall a. [a] -> Pattern a
choose [Int
1 :: Int,Int
2,Int
3]) [Int
0 .. (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)]
let rats :: [Rational]
rats = (Int -> Rational) -> [Int] -> [Rational]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Rational
forall a. Real a => a -> Rational
toRational [Int]
rs
total :: Rational
total = [Rational] -> Rational
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Rational]
rats
pairs :: [Arc]
pairs = [Rational] -> [Arc]
forall {a}. Num a => [a] -> [ArcF a]
pairUp ([Rational] -> [Arc]) -> [Rational] -> [Arc]
forall a b. (a -> b) -> a -> b
$ [Rational] -> [Rational]
forall t. Num t => [t] -> [t]
accumulate ([Rational] -> [Rational]) -> [Rational] -> [Rational]
forall a b. (a -> b) -> a -> b
$ (Rational -> Rational) -> [Rational] -> [Rational]
forall a b. (a -> b) -> [a] -> [b]
map (Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
total) [Rational]
rats
[Arc] -> Pattern [Arc]
forall (m :: * -> *) a. Monad m => a -> m a
return [Arc]
pairs
where pairUp :: [a] -> [ArcF a]
pairUp [] = []
pairUp [a]
xs = a -> a -> ArcF a
forall a. a -> a -> ArcF a
Arc a
0 ([a] -> a
forall a. [a] -> a
head [a]
xs) ArcF a -> [ArcF a] -> [ArcF a]
forall a. a -> [a] -> [a]
: [a] -> [ArcF a]
forall {a}. Num a => [a] -> [ArcF a]
pairUp' [a]
xs
pairUp' :: [a] -> [ArcF a]
pairUp' [] = []
pairUp' [a
_] = []
pairUp' [a
a, a
_] = [a -> a -> ArcF a
forall a. a -> a -> ArcF a
Arc a
a a
1]
pairUp' (a
a:a
b:[a]
xs) = a -> a -> ArcF a
forall a. a -> a -> ArcF a
Arc a
a a
bArcF a -> [ArcF a] -> [ArcF a]
forall a. a -> [a] -> [a]
: [a] -> [ArcF a]
pairUp' (a
ba -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)
randStruct :: Int -> Pattern Int
randStruct :: Int -> Pattern Int
randStruct Int
n = Pattern Int -> Pattern Int
forall a. Pattern a -> Pattern a
splitQueries (Pattern Int -> Pattern Int) -> Pattern Int -> Pattern Int
forall a b. (a -> b) -> a -> b
$ Pattern :: forall a. (State -> [Event a]) -> Pattern a
Pattern {query :: State -> [Event Int]
query = State -> [Event Int]
f}
where f :: State -> [Event Int]
f State
st = ((Arc, Maybe Arc, Int) -> Event Int)
-> [(Arc, Maybe Arc, Int)] -> [Event Int]
forall a b. (a -> b) -> [a] -> [b]
map (\(Arc
a,Maybe Arc
b,Int
c) -> Context -> Maybe Arc -> Arc -> Int -> Event Int
forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event ([((Int, Int), (Int, Int))] -> Context
Context []) (Arc -> Maybe Arc
forall a. a -> Maybe a
Just Arc
a) (Maybe Arc -> Arc
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Arc
b) Int
c) ([(Arc, Maybe Arc, Int)] -> [Event Int])
-> [(Arc, Maybe Arc, Int)] -> [Event Int]
forall a b. (a -> b) -> a -> b
$ ((Arc, Maybe Arc, Int) -> Bool)
-> [(Arc, Maybe Arc, Int)] -> [(Arc, Maybe Arc, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Arc
_,Maybe Arc
x,Int
_) -> Maybe Arc -> Bool
forall a. Maybe a -> Bool
isJust Maybe Arc
x) [(Arc, Maybe Arc, Int)]
as
where as :: [(Arc, Maybe Arc, Int)]
as = ((Int, Arc) -> (Arc, Maybe Arc, Int))
-> [(Int, Arc)] -> [(Arc, Maybe Arc, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
i, Arc Rational
s' Rational
e') ->
(Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc (Rational
s' Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational -> Rational
sam Rational
s) (Rational
e' Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational -> Rational
sam Rational
s),
Arc -> Arc -> Maybe Arc
subArc (Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc Rational
s Rational
e) (Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc (Rational
s' Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational -> Rational
sam Rational
s) (Rational
e' Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational -> Rational
sam Rational
s)), Int
i)) ([(Int, Arc)] -> [(Arc, Maybe Arc, Int)])
-> [(Int, Arc)] -> [(Arc, Maybe Arc, Int)]
forall a b. (a -> b) -> a -> b
$
[Arc] -> [(Int, Arc)]
forall a. [a] -> [(Int, a)]
enumerate ([Arc] -> [(Int, Arc)]) -> [Arc] -> [(Int, Arc)]
forall a b. (a -> b) -> a -> b
$ EventF Arc [Arc] -> [Arc]
forall a b. EventF a b -> b
value (EventF Arc [Arc] -> [Arc]) -> EventF Arc [Arc] -> [Arc]
forall a b. (a -> b) -> a -> b
$ [EventF Arc [Arc]] -> EventF Arc [Arc]
forall a. [a] -> a
head ([EventF Arc [Arc]] -> EventF Arc [Arc])
-> [EventF Arc [Arc]] -> EventF Arc [Arc]
forall a b. (a -> b) -> a -> b
$
Pattern [Arc] -> Arc -> [EventF Arc [Arc]]
forall a. Pattern a -> Arc -> [Event a]
queryArc (Int -> Pattern [Arc]
randArcs Int
n) (Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc (Rational -> Rational
sam Rational
s) (Rational -> Rational
nextSam Rational
s))
(Arc Rational
s Rational
e) = State -> Arc
arc State
st
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 -> (Event Int -> [Event a]) -> [Event Int] -> [Event a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (State -> Event Int -> [Event a]
forall {a}. Real a => State -> EventF Arc a -> [Event a]
f State
st) (Pattern Int -> State -> [Event Int]
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) = (Event a -> Event a) -> [Event a] -> [Event a]
forall a b. (a -> b) -> [a] -> [b]
map (\Event a
e -> Event a
e {context :: Context
context = [Context] -> Context
combineContexts [Context
c, Event a -> Context
forall a b. EventF a b -> Context
context Event a
e]}) ([Event a] -> [Event a]) -> [Event a] -> [Event a]
forall a b. (a -> b) -> a -> b
$ Pattern a -> Arc -> [Event a]
forall a. Pattern a -> Arc -> [Event a]
queryArc (Arc -> Pattern a -> Pattern a
forall a. Arc -> Pattern a -> Pattern a
compressArcTo Arc
a' (Pattern Rational
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a1 a.
Pattern Rational
-> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
inside (Rational -> Pattern Rational
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rational -> Pattern Rational) -> Rational -> Pattern Rational
forall a b. (a -> b) -> a -> b
$ Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Int -> Rational
forall a. Real a => a -> Rational
toRational([Event Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Pattern Int -> Arc -> [Event Int]
forall a. Pattern a -> Arc -> [Event a]
queryArc Pattern Int
s (Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc (Rational -> Rational
sam (Arc -> Rational
forall a. ArcF a -> a
start (Arc -> Rational) -> Arc -> Rational
forall a b. (a -> b) -> a -> b
$ State -> Arc
arc State
st)) (Rational -> Rational
nextSam (Arc -> Rational
forall a. ArcF a -> a
start (Arc -> Rational) -> Arc -> Rational
forall a b. (a -> b) -> a -> b
$ State -> Arc
arc State
st)))))) (Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
rotR (a -> Rational
forall a. Real a => a -> Rational
toRational a
i)) Pattern a
p)) Arc
a'
f State
_ EventF Arc a
_ = []
stripe :: Pattern Int -> Pattern a -> Pattern a
stripe :: forall c. Pattern Int -> Pattern c -> Pattern c
stripe = (Int -> Pattern a -> Pattern a)
-> Pattern Int -> Pattern a -> Pattern a
forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam Int -> Pattern a -> Pattern a
forall a. Int -> Pattern a -> Pattern a
_stripe
_stripe :: Int -> Pattern a -> Pattern a
_stripe :: forall a. Int -> Pattern a -> Pattern a
_stripe = Pattern Int -> Pattern a -> Pattern a
forall c. Pattern Int -> Pattern c -> Pattern c
substruct' (Pattern Int -> Pattern a -> Pattern a)
-> (Int -> Pattern Int) -> Int -> Pattern a -> Pattern a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Pattern Int
randStruct
slowstripe :: Pattern Int -> Pattern a -> Pattern a
slowstripe :: forall c. Pattern Int -> Pattern c -> Pattern c
slowstripe Pattern Int
n = Pattern Rational -> Pattern a -> Pattern a
forall a. Pattern Rational -> Pattern a -> Pattern a
slow (Int -> Rational
forall a. Real a => a -> Rational
toRational (Int -> Rational) -> Pattern Int -> Pattern Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Int
n) (Pattern a -> Pattern a)
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern Int -> Pattern a -> Pattern a
forall c. Pattern Int -> Pattern c -> Pattern c
stripe Pattern Int
n
parseLMRule :: String -> [(String,String)]
parseLMRule :: [Char] -> [([Char], [Char])]
parseLMRule [Char]
s = ([Char] -> ([Char], [Char])) -> [[Char]] -> [([Char], [Char])]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> [Char] -> ([Char], [Char])
forall {a}. Eq a => a -> [a] -> ([a], [a])
splitOn Char
':') [[Char]]
commaSplit
where splitOn :: a -> [a] -> ([a], [a])
splitOn a
sep [a]
str = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt (Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ a -> [a] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex a
sep [a]
str)
([a] -> ([a], [a])) -> [a] -> ([a], [a])
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
sep) [a]
str
commaSplit :: [[Char]]
commaSplit = (Text -> [Char]) -> [Text] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Text -> [Char]
T.unpack ([Text] -> [[Char]]) -> [Text] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
T.splitOn ([Char] -> Text
T.pack [Char]
",") (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
s
parseLMRule' :: String -> [(Char, String)]
parseLMRule' :: [Char] -> [(Char, [Char])]
parseLMRule' [Char]
str = (([Char], [Char]) -> (Char, [Char]))
-> [([Char], [Char])] -> [(Char, [Char])]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], [Char]) -> (Char, [Char])
forall {a} {b}. ([a], b) -> (a, b)
fixer ([([Char], [Char])] -> [(Char, [Char])])
-> [([Char], [Char])] -> [(Char, [Char])]
forall a b. (a -> b) -> a -> b
$ [Char] -> [([Char], [Char])]
parseLMRule [Char]
str
where fixer :: ([a], b) -> (a, b)
fixer ([a]
c,b
r) = ([a] -> a
forall a. [a] -> a
head [a]
c, b
r)
lindenmayer :: Int -> String -> String -> String
lindenmayer :: Int -> [Char] -> [Char] -> [Char]
lindenmayer Int
_ [Char]
_ [] = []
lindenmayer Int
1 [Char]
r (Char
c:[Char]
cs) = [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char
c] (Char -> [(Char, [Char])] -> Maybe [Char]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Char
c ([(Char, [Char])] -> Maybe [Char])
-> [(Char, [Char])] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [(Char, [Char])]
parseLMRule' [Char]
r)
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char] -> [Char] -> [Char]
lindenmayer Int
1 [Char]
r [Char]
cs
lindenmayer Int
n [Char]
r [Char]
s = ([Char] -> [Char]) -> [Char] -> [[Char]]
forall a. (a -> a) -> a -> [a]
iterate (Int -> [Char] -> [Char] -> [Char]
lindenmayer Int
1 [Char]
r) [Char]
s [[Char]] -> Int -> [Char]
forall a. [a] -> Int -> a
!! Int
n
lindenmayerI :: Num b => Int -> String -> String -> [b]
lindenmayerI :: forall b. Num b => Int -> [Char] -> [Char] -> [b]
lindenmayerI Int
n [Char]
r [Char]
s = (Char -> b) -> [Char] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> b) -> (Char -> Int) -> Char -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
digitToInt) ([Char] -> [b]) -> [Char] -> [b]
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [Char] -> [Char]
lindenmayer Int
n [Char]
r [Char]
s
runMarkov :: Int -> [[Double]] -> Int -> Time -> [Int]
runMarkov :: Int -> [[Double]] -> Int -> Rational -> [Int]
runMarkov Int
n [[Double]]
tp Int
xi Rational
seed = [Int] -> [Int]
forall a. [a] -> [a]
reverse ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (([Int] -> [Int]) -> [Int] -> [[Int]]
forall a. (a -> a) -> a -> [a]
iterate ([[Double]] -> [Int] -> [Int]
forall {a}. (Ord a, Fractional a) => [[a]] -> [Int] -> [Int]
markovStep ([[Double]] -> [Int] -> [Int]) -> [[Double]] -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ [[Double]]
renorm) [Int
xi])[[Int]] -> Int -> [Int]
forall a. [a] -> Int -> a
!! (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) where
markovStep :: [[a]] -> [Int] -> [Int]
markovStep [[a]]
tp' [Int]
xs = (Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> [a] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (a
r a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<=) ([a] -> Maybe Int) -> [a] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> [a] -> [a]
forall a. (a -> a -> a) -> [a] -> [a]
scanl1 a -> a -> a
forall a. Num a => a -> a -> a
(+) ([[a]]
tp'[[a]] -> Int -> [a]
forall a. [a] -> Int -> a
!!([Int] -> Int
forall a. [a] -> a
head [Int]
xs))) Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
xs where
r :: a
r = Rational -> a
forall a b. (RealFrac a, Fractional b) => a -> b
timeToRand (Rational -> a) -> Rational -> a
forall a b. (a -> b) -> a -> b
$ Rational
seed Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Rational) -> ([Int] -> Int) -> [Int] -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) [Int]
xs Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
renorm :: [[Double]]
renorm = [ (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
x) [Double]
x | [Double]
x <- [[Double]]
tp ]
markovPat :: Pattern Int -> Pattern Int -> [[Double]] -> Pattern Int
markovPat :: Pattern Int -> Pattern Int -> [[Double]] -> Pattern Int
markovPat = (Int -> Int -> [[Double]] -> Pattern Int)
-> Pattern Int -> Pattern Int -> [[Double]] -> Pattern Int
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 = Pattern Int -> Pattern Int
forall a. Pattern a -> Pattern a
splitQueries (Pattern Int -> Pattern Int) -> Pattern Int -> Pattern Int
forall a b. (a -> b) -> a -> b
$ (State -> [Event Int]) -> Pattern Int
forall a. (State -> [Event a]) -> Pattern a
Pattern (\(State a :: Arc
a@(Arc Rational
s Rational
_) ValueMap
_) ->
Pattern Int -> Arc -> [Event Int]
forall a. Pattern a -> Arc -> [Event a]
queryArc ([Int] -> Pattern Int
forall a. [a] -> Pattern a
listToPat ([Int] -> Pattern Int) -> [Int] -> Pattern Int
forall a b. (a -> b) -> a -> b
$ Int -> [[Double]] -> Int -> Rational -> [Int]
runMarkov Int
n [[Double]]
tp Int
xi (Rational -> Rational
sam Rational
s)) Arc
a)
mask :: Pattern Bool -> Pattern a -> Pattern a
mask :: forall a. Pattern Bool -> Pattern a -> Pattern a
mask Pattern Bool
b Pattern a
p = a -> Bool -> a
forall a b. a -> b -> a
const (a -> Bool -> a) -> Pattern a -> Pattern (Bool -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
p Pattern (Bool -> a) -> Pattern Bool -> Pattern a
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
<* ((Bool -> Bool) -> Pattern Bool -> Pattern Bool
forall a. (a -> Bool) -> Pattern a -> Pattern a
filterValues Bool -> Bool
forall a. a -> a
id Pattern Bool
b)
enclosingArc :: [Arc] -> Arc
enclosingArc :: [Arc] -> Arc
enclosingArc [] = Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc Rational
0 Rational
1
enclosingArc [Arc]
as = Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc ([Rational] -> Rational
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ((Arc -> Rational) -> [Arc] -> [Rational]
forall a b. (a -> b) -> [a] -> [b]
map Arc -> Rational
forall a. ArcF a -> a
start [Arc]
as)) ([Rational] -> Rational
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((Arc -> Rational) -> [Arc] -> [Rational]
forall a b. (a -> b) -> [a] -> [b]
map Arc -> Rational
forall a. ArcF a -> a
stop [Arc]
as))
stretch :: Pattern a -> Pattern a
stretch :: forall a. Pattern a -> Pattern a
stretch Pattern a
p = Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
splitQueries (Pattern a -> Pattern a) -> Pattern a -> Pattern a
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 = Pattern a -> State -> [Event a]
forall a. Pattern a -> State -> [Event a]
query (Arc -> Pattern a -> Pattern a
forall a. Arc -> Pattern a -> Pattern a
zoomArc (Arc -> Arc
cycleArc (Arc -> Arc) -> Arc -> Arc
forall a b. (a -> b) -> a -> b
$ [Arc] -> Arc
enclosingArc ([Arc] -> Arc) -> [Arc] -> Arc
forall a b. (a -> b) -> a -> b
$ (Event a -> Arc) -> [Event a] -> [Arc]
forall a b. (a -> b) -> [a] -> [b]
map Event a -> Arc
forall a. Event a -> Arc
wholeOrPart ([Event a] -> [Arc]) -> [Event a] -> [Arc]
forall a b. (a -> b) -> a -> b
$ Pattern a -> State -> [Event a]
forall a. Pattern a -> State -> [Event a]
query Pattern a
p (State
st {arc :: Arc
arc = Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc (Rational -> Rational
sam Rational
s) (Rational -> Rational
nextSam Rational
s)})) Pattern a
p) State
st
where s :: Rational
s = Arc -> Rational
forall a. ArcF a -> a
start (Arc -> Rational) -> Arc -> Rational
forall a b. (a -> b) -> a -> b
$ State -> Arc
arc State
st
fit' :: Pattern Time -> Int -> Pattern Int -> Pattern Int -> Pattern a -> Pattern a
fit' :: forall a.
Pattern Rational
-> Int -> Pattern Int -> Pattern Int -> Pattern a -> Pattern a
fit' Pattern Rational
cyc Int
n Pattern Int
from Pattern Int
to Pattern a
p = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
squeezeJoin (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ Int -> [Pattern a] -> Pattern Int -> Pattern (Pattern a)
forall a. Int -> [a] -> Pattern Int -> Pattern a
_fit Int
n [Pattern a]
mapMasks Pattern Int
to
where mapMasks :: [Pattern a]
mapMasks = [Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
stretch (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ Pattern Bool -> Pattern a -> Pattern a
forall a. Pattern Bool -> Pattern a -> Pattern a
mask (Bool -> Int -> Bool
forall a b. a -> b -> a
const Bool
True (Int -> Bool) -> Pattern Int -> Pattern Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Bool) -> Pattern Int -> Pattern Int
forall a. (a -> Bool) -> Pattern a -> Pattern a
filterValues (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i) Pattern Int
from') Pattern a
p'
| Int
i <- [Int
0..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]]
p' :: Pattern a
p' = Pattern Rational -> Pattern a -> Pattern a
forall a. Pattern Rational -> Pattern a -> Pattern a
density Pattern Rational
cyc Pattern a
p
from' :: Pattern Int
from' = Pattern Rational -> Pattern Int -> Pattern Int
forall a. Pattern Rational -> Pattern a -> Pattern a
density Pattern Rational
cyc Pattern Int
from
_chunk :: Int -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b
_chunk :: forall b. Int -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b
_chunk Int
n Pattern b -> Pattern b
f Pattern b
p = [Pattern b] -> Pattern b
forall a. [Pattern a] -> Pattern a
cat [Arc -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b
forall a. Arc -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
withinArc (Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc (Integer
i Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) ((Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)) Pattern b -> Pattern b
f Pattern b
p | Integer
i <- [Integer
0 .. Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1]]
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 = Pattern (Pattern b) -> Pattern b
forall a. Pattern (Pattern a) -> Pattern a
innerJoin (Pattern (Pattern b) -> Pattern b)
-> Pattern (Pattern b) -> Pattern b
forall a b. (a -> b) -> a -> b
$ (\Int
n -> Int -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b
forall b. Int -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b
_chunk Int
n Pattern b -> Pattern b
f Pattern b
p) (Int -> Pattern b) -> Pattern Int -> Pattern (Pattern b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Int
npat
runWith :: Int -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b
runWith :: forall b. Int -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b
runWith = Int -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b
forall b. Int -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b
_chunk
_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 = do Integer
i <- Rational -> Pattern Integer -> Pattern Integer
forall a. Rational -> Pattern a -> Pattern a
_slow (a -> Rational
forall a. Real a => a -> Rational
toRational a
n) (Pattern Integer -> Pattern Integer)
-> Pattern Integer -> Pattern Integer
forall a b. (a -> b) -> a -> b
$ Pattern Integer -> Pattern Integer
forall a. Pattern a -> Pattern a
rev (Pattern Integer -> Pattern Integer)
-> Pattern Integer -> Pattern Integer
forall a b. (a -> b) -> a -> b
$ Pattern Integer -> Pattern Integer
forall a. (Enum a, Num a) => Pattern a -> Pattern a
run (a -> Pattern Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n)
Arc -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b
forall a. Arc -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
withinArc (Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc (Integer
i Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n) ((Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+)Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n)) Pattern b -> Pattern b
f Pattern b
p
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 = Pattern (Pattern a2) -> Pattern a2
forall a. Pattern (Pattern a) -> Pattern a
innerJoin (Pattern (Pattern a2) -> Pattern a2)
-> Pattern (Pattern a2) -> Pattern a2
forall a b. (a -> b) -> a -> b
$ (\a1
n -> a1 -> (Pattern a2 -> Pattern a2) -> Pattern a2 -> Pattern a2
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) (a1 -> Pattern a2) -> Pattern a1 -> Pattern (Pattern a2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a1
npat
_inside :: Time -> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
_inside :: forall a1 a.
Rational -> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
_inside Rational
n Pattern a1 -> Pattern a
f Pattern a1
p = Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
_fast Rational
n (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ Pattern a1 -> Pattern a
f (Rational -> Pattern a1 -> Pattern a1
forall a. Rational -> Pattern a -> Pattern a
_slow Rational
n Pattern a1
p)
inside :: Pattern Time -> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
inside :: forall a1 a.
Pattern Rational
-> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
inside Pattern Rational
np Pattern a1 -> Pattern a
f Pattern a1
p = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
innerJoin (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ (\Rational
n -> Rational -> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
forall a1 a.
Rational -> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
_inside Rational
n Pattern a1 -> Pattern a
f Pattern a1
p) (Rational -> Pattern a) -> Pattern Rational -> Pattern (Pattern a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Rational
np
_outside :: Time -> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
_outside :: forall a1 a.
Rational -> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
_outside Rational
n = Rational -> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
forall a1 a.
Rational -> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
_inside (Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
n)
outside :: Pattern Time -> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
outside :: forall a1 a.
Pattern Rational
-> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
outside Pattern Rational
np Pattern a1 -> Pattern a
f Pattern a1
p = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
innerJoin (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ (\Rational
n -> Rational -> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
forall a1 a.
Rational -> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
_outside Rational
n Pattern a1 -> Pattern a
f Pattern a1
p) (Rational -> Pattern a) -> Pattern Rational -> Pattern (Pattern a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Rational
np
loopFirst :: Pattern a -> Pattern a
loopFirst :: forall a. Pattern a -> Pattern a
loopFirst Pattern a
p = Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
splitQueries (Pattern a -> Pattern a) -> Pattern a -> Pattern a
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 = (Event a -> Event a) -> [Event a] -> [Event a]
forall a b. (a -> b) -> [a] -> [b]
map
(\(Event Context
c Maybe Arc
w Arc
p' a
v) ->
Context -> Maybe Arc -> Arc -> a -> Event a
forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event Context
c (Arc -> Arc
plus (Arc -> Arc) -> Maybe Arc -> Maybe Arc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Arc
w) (Arc -> Arc
plus Arc
p') a
v) ([Event a] -> [Event a]) -> [Event a] -> [Event a]
forall a b. (a -> b) -> a -> b
$
Pattern a -> State -> [Event a]
forall a. Pattern a -> State -> [Event a]
query Pattern a
p (State
st {arc :: Arc
arc = Arc -> Arc
minus (Arc -> Arc) -> Arc -> Arc
forall a b. (a -> b) -> a -> b
$ State -> Arc
arc State
st})
where minus :: Arc -> Arc
minus = (Rational -> Rational) -> Arc -> Arc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
subtract (Rational -> Rational
sam Rational
s))
plus :: Arc -> Arc
plus = (Rational -> Rational) -> Arc -> Arc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational -> Rational
sam Rational
s)
s :: Rational
s = Arc -> Rational
forall a. ArcF a -> a
start (Arc -> Rational) -> Arc -> Rational
forall a b. (a -> b) -> a -> b
$ State -> Arc
arc State
st
timeLoop :: Pattern Time -> Pattern a -> Pattern a
timeLoop :: forall a. Pattern Rational -> Pattern a -> Pattern a
timeLoop Pattern Rational
n = Pattern Rational
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a1 a.
Pattern Rational
-> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
outside Pattern Rational
n Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
loopFirst
seqPLoop :: [(Time, Time, Pattern a)] -> Pattern a
seqPLoop :: forall a. [(Rational, Rational, Pattern a)] -> Pattern a
seqPLoop [(Rational, Rational, Pattern a)]
ps = Pattern Rational -> Pattern a -> Pattern a
forall a. Pattern Rational -> Pattern a -> Pattern a
timeLoop (Rational -> Pattern Rational
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rational -> Pattern Rational) -> Rational -> Pattern Rational
forall a b. (a -> b) -> a -> b
$ Rational
maxT Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
minT) (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ Rational
minT Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
`rotL` [(Rational, Rational, Pattern a)] -> Pattern a
forall a. [(Rational, Rational, Pattern a)] -> Pattern a
seqP [(Rational, Rational, Pattern a)]
ps
where minT :: Rational
minT = [Rational] -> Rational
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Rational] -> Rational) -> [Rational] -> Rational
forall a b. (a -> b) -> a -> b
$ ((Rational, Rational, Pattern a) -> Rational)
-> [(Rational, Rational, Pattern a)] -> [Rational]
forall a b. (a -> b) -> [a] -> [b]
map (\(Rational
x,Rational
_,Pattern a
_) -> Rational
x) [(Rational, Rational, Pattern a)]
ps
maxT :: Rational
maxT = [Rational] -> Rational
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Rational] -> Rational) -> [Rational] -> Rational
forall a b. (a -> b) -> a -> b
$ ((Rational, Rational, Pattern a) -> Rational)
-> [(Rational, Rational, Pattern a)] -> [Rational]
forall a b. (a -> b) -> [a] -> [b]
map (\(Rational
_,Rational
x,Pattern a
_) -> Rational
x) [(Rational, Rational, Pattern a)]
ps
toScale' :: Num a => Int -> [a] -> Pattern Int -> Pattern a
toScale' :: forall a. Num a => Int -> [a] -> Pattern Int -> Pattern a
toScale' Int
_ [] = Pattern a -> Pattern Int -> Pattern a
forall a b. a -> b -> a
const Pattern a
forall a. Pattern a
silence
toScale' Int
o [a]
s = (Int -> a) -> Pattern Int -> Pattern a
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 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
s
noteInScale :: Int -> a
noteInScale Int
x = ([a]
s [a] -> Int -> a
forall a. [a] -> Int -> a
!!! Int
x) a -> a -> a
forall a. Num a => a -> a -> a
+ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
o Int -> Int -> Int
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 = Int -> [a] -> Pattern Int -> Pattern a
forall a. Num a => Int -> [a] -> Pattern Int -> Pattern a
toScale' Int
12
swingBy :: Pattern Time -> Pattern Time -> Pattern a -> Pattern a
swingBy :: forall a.
Pattern Rational -> Pattern Rational -> Pattern a -> Pattern a
swingBy Pattern Rational
x Pattern Rational
n = Pattern Rational
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a1 a.
Pattern Rational
-> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
inside Pattern Rational
n (Arc -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a. Arc -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
withinArc (Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc Rational
0.5 Rational
1) (Pattern Rational
x Pattern Rational -> Pattern a -> Pattern a
forall a. Pattern Rational -> Pattern a -> Pattern a
~>))
swing :: Pattern Time -> Pattern a -> Pattern a
swing :: forall a. Pattern Rational -> Pattern a -> Pattern a
swing = Pattern Rational -> Pattern Rational -> Pattern a -> Pattern a
forall a.
Pattern Rational -> Pattern Rational -> Pattern a -> Pattern a
swingBy (Rational -> Pattern Rational
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rational -> Pattern Rational) -> Rational -> Pattern Rational
forall a b. (a -> b) -> a -> b
$ Integer
1Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
3)
cycleChoose :: [a] -> Pattern a
cycleChoose :: forall a. [a] -> Pattern a
cycleChoose = Pattern Rational -> Pattern a -> Pattern a
forall a. Pattern Rational -> Pattern a -> Pattern a
segment Pattern Rational
1 (Pattern a -> Pattern a) -> ([a] -> Pattern a) -> [a] -> Pattern a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Pattern a
forall a. [a] -> Pattern a
choose
_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 = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
innerJoin (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ (\Int
i -> Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
_fast Rational
nT (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ Int -> Pattern a -> Pattern a
forall a. Int -> Pattern a -> Pattern a
_repeatCycles Int
n (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ [Pattern a]
pats [Pattern a] -> Int -> Pattern a
forall a. [a] -> Int -> a
!! Int
i) (Int -> Pattern a) -> Pattern Int -> Pattern (Pattern a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Int
ipat
where
pats :: [Pattern a]
pats = (Int -> Pattern a) -> [Int] -> [Pattern a]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> (Rational, Rational) -> Pattern a -> Pattern a
forall a. (Rational, Rational) -> Pattern a -> Pattern a
zoom (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
nT, Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
nT) Pattern a
pat) [Int
0 .. (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)]
nT :: Time
nT :: Rational
nT = Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
shuffle :: Pattern Int -> Pattern a -> Pattern a
shuffle :: forall c. Pattern Int -> Pattern c -> Pattern c
shuffle = (Int -> Pattern a -> Pattern a)
-> Pattern Int -> Pattern a -> Pattern a
forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam Int -> Pattern a -> Pattern a
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 = Pattern Int -> Int -> Pattern a -> Pattern a
forall a. Pattern Int -> Int -> Pattern a -> Pattern a
_rearrangeWith (Int -> Pattern Int
randrun Int
n) Int
n
scramble :: Pattern Int -> Pattern a -> Pattern a
scramble :: forall c. Pattern Int -> Pattern c -> Pattern c
scramble = (Int -> Pattern a -> Pattern a)
-> Pattern Int -> Pattern a -> Pattern a
forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam Int -> Pattern a -> Pattern a
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 = Pattern Int -> Int -> Pattern a -> Pattern a
forall a. Pattern Int -> Int -> Pattern a -> Pattern a
_rearrangeWith (Rational -> Pattern Int -> Pattern Int
forall a. Rational -> Pattern a -> Pattern a
_segment (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) (Pattern Int -> Pattern Int) -> Pattern Int -> Pattern Int
forall a b. (a -> b) -> a -> b
$ Int -> Pattern Int
forall a. Num a => Int -> Pattern a
_irand Int
n) Int
n
randrun :: Int -> Pattern Int
randrun :: Int -> Pattern Int
randrun Int
0 = Pattern Int
forall a. Pattern a
silence
randrun Int
n' =
Pattern Int -> Pattern Int
forall a. Pattern a -> Pattern a
splitQueries (Pattern Int -> Pattern Int) -> Pattern Int -> Pattern Int
forall a b. (a -> b) -> a -> b
$ (State -> [Event Int]) -> Pattern Int
forall a. (State -> [Event a]) -> Pattern a
Pattern (\(State a :: Arc
a@(Arc Rational
s Rational
_) ValueMap
_) -> Arc -> Rational -> [Event Int]
forall {p}. RealFrac p => Arc -> p -> [Event Int]
events Arc
a (Rational -> [Event Int]) -> Rational -> [Event Int]
forall a b. (a -> b) -> a -> b
$ Rational -> Rational
sam Rational
s)
where events :: Arc -> p -> [Event Int]
events Arc
a p
seed = ((Arc, Int) -> Maybe (Event Int)) -> [(Arc, Int)] -> [Event Int]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Arc, Int) -> Maybe (Event Int)
forall {b}. (Arc, b) -> Maybe (EventF Arc b)
toEv ([(Arc, Int)] -> [Event Int]) -> [(Arc, Int)] -> [Event Int]
forall a b. (a -> b) -> a -> b
$ [Arc] -> [Int] -> [(Arc, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Arc]
arcs [Int]
shuffled
where shuffled :: [Int]
shuffled = ((Double, Int) -> Int) -> [(Double, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Double, Int) -> Int
forall a b. (a, b) -> b
snd ([(Double, Int)] -> [Int]) -> [(Double, Int)] -> [Int]
forall a b. (a -> b) -> a -> b
$ ((Double, Int) -> Double) -> [(Double, Int)] -> [(Double, Int)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Double, Int) -> Double
forall a b. (a, b) -> a
fst ([(Double, Int)] -> [(Double, Int)])
-> [(Double, Int)] -> [(Double, Int)]
forall a b. (a -> b) -> a -> b
$ [Double] -> [Int] -> [(Double, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Double]
rs [Int
0 .. (Int
n'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)]
rs :: [Double]
rs = p -> Int -> [Double]
forall a b. (RealFrac a, Fractional b) => a -> Int -> [b]
timeToRands p
seed Int
n' :: [Double]
arcs :: [Arc]
arcs = (Rational -> Rational -> Arc) -> [Rational] -> [Rational] -> [Arc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc [Rational]
fractions ([Rational] -> [Rational]
forall a. [a] -> [a]
tail [Rational]
fractions)
fractions :: [Rational]
fractions = (Rational -> Rational) -> [Rational] -> [Rational]
forall a b. (a -> b) -> [a] -> [b]
map (Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ (Rational -> Rational
sam (Rational -> Rational) -> Rational -> Rational
forall a b. (a -> b) -> a -> b
$ Arc -> Rational
forall a. ArcF a -> a
start Arc
a)) [Rational
0, Rational
1 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n' .. Rational
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'
EventF Arc b -> Maybe (EventF Arc b)
forall (m :: * -> *) a. Monad m => a -> m a
return (EventF Arc b -> Maybe (EventF Arc b))
-> EventF Arc b -> Maybe (EventF Arc b)
forall a b. (a -> b) -> a -> b
$ Context -> Maybe Arc -> Arc -> b -> EventF Arc b
forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event ([((Int, Int), (Int, Int))] -> Context
Context []) (Arc -> Maybe Arc
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.
Rational
-> Pattern [Char]
-> [([Char], Pattern a)]
-> [([Char], Pattern a -> Pattern a)]
-> Pattern a
ur Rational
t Pattern [Char]
outer_p [([Char], Pattern a)]
ps [([Char], Pattern a -> Pattern a)]
fs = Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
_slow Rational
t (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
unwrap (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ (Arc, (Pattern a, Arc -> Pattern a -> Pattern a)) -> Pattern a
forall {t} {t} {t}. (t, (t, t -> t -> t)) -> t
adjust ((Arc, (Pattern a, Arc -> Pattern a -> Pattern a)) -> Pattern a)
-> Pattern (Arc, (Pattern a, Arc -> Pattern a -> Pattern a))
-> Pattern (Pattern a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern (Pattern a, Arc -> Pattern a -> Pattern a)
-> Pattern (Arc, (Pattern a, Arc -> Pattern a -> Pattern a))
forall {b}. Pattern b -> Pattern (Arc, b)
timedValues ([[Char]] -> (Pattern a, Arc -> Pattern a -> Pattern a)
getPat ([[Char]] -> (Pattern a, Arc -> Pattern a -> Pattern a))
-> ([Char] -> [[Char]])
-> [Char]
-> (Pattern a, Arc -> Pattern a -> Pattern a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
split ([Char] -> (Pattern a, Arc -> Pattern a -> Pattern a))
-> Pattern [Char]
-> Pattern (Pattern a, Arc -> Pattern a -> Pattern a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern [Char]
outer_p)
where split :: [Char] -> [[Char]]
split = (Char -> Bool) -> [Char] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [[a]]
wordsBy (Char -> Char -> Bool
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)
getPat [[Char]]
_ = [Char] -> (Pattern a, Arc -> Pattern a -> Pattern a)
forall a. HasCallStack => [Char] -> a
error [Char]
"can't happen?"
match :: [Char] -> Pattern a
match [Char]
s = Pattern a -> Maybe (Pattern a) -> Pattern a
forall a. a -> Maybe a -> a
fromMaybe Pattern a
forall a. Pattern a
silence (Maybe (Pattern a) -> Pattern a) -> Maybe (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ [Char] -> [([Char], Pattern a)] -> Maybe (Pattern a)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
s [([Char], Pattern a)]
ps'
ps' :: [([Char], Pattern a)]
ps' = (([Char], Pattern a) -> ([Char], Pattern a))
-> [([Char], Pattern a)] -> [([Char], Pattern a)]
forall a b. (a -> b) -> [a] -> [b]
map ((Pattern a -> Pattern a)
-> ([Char], Pattern a) -> ([Char], Pattern a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
_fast Rational
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
_ = Pattern a -> Pattern a
forall a. a -> a
id
transform' :: [Char] -> Arc -> Pattern a -> Pattern a
transform' [Char]
str (Arc Rational
s Rational
e) Pattern a
p = Rational
s Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
`rotR` Pattern Rational
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a1 a.
Pattern Rational
-> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
inside (Rational -> Pattern Rational
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rational -> Pattern Rational) -> Rational -> Pattern Rational
forall a b. (a -> b) -> a -> b
$ Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/(Rational
eRational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
s)) ([Char] -> Pattern a -> Pattern a
matchF [Char]
str) Pattern a
p
matchF :: [Char] -> Pattern a -> Pattern a
matchF [Char]
str = (Pattern a -> Pattern a)
-> Maybe (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a. a -> Maybe a -> a
fromMaybe Pattern a -> Pattern a
forall a. a -> a
id (Maybe (Pattern a -> Pattern a) -> Pattern a -> Pattern a)
-> Maybe (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ [Char]
-> [([Char], Pattern a -> Pattern a)]
-> Maybe (Pattern a -> Pattern a)
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 = (Event b -> Event (Arc, b)) -> Pattern b -> Pattern (Arc, b)
forall a b. (Event a -> Event b) -> Pattern a -> Pattern b
withEvent (\(Event Context
c (Just Arc
a) Arc
a' b
v) -> Context -> Maybe Arc -> Arc -> (Arc, b) -> Event (Arc, b)
forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event Context
c (Arc -> Maybe Arc
forall a. a -> Maybe a
Just Arc
a) Arc
a' (Arc
a,b
v)) (Pattern b -> Pattern (Arc, b))
-> (Pattern b -> Pattern b) -> Pattern b -> Pattern (Arc, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern b -> Pattern b
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 = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
squeezeJoin (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ (\[Char]
s -> Pattern a -> Maybe (Pattern a) -> Pattern a
forall a. a -> Maybe a -> a
fromMaybe Pattern a
forall a. Pattern a
silence (Maybe (Pattern a) -> Pattern a) -> Maybe (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ [Char] -> [([Char], Pattern a)] -> Maybe (Pattern a)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
s [([Char], Pattern a)]
ps) ([Char] -> Pattern a) -> Pattern [Char] -> Pattern (Pattern a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern [Char]
p
spaceOut :: [Time] -> Pattern a -> Pattern a
spaceOut :: forall a. [Rational] -> Pattern a -> Pattern a
spaceOut [Rational]
xs Pattern a
p = Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
_slow (Rational -> Rational
forall a. Real a => a -> Rational
toRational (Rational -> Rational) -> Rational -> Rational
forall a b. (a -> b) -> a -> b
$ [Rational] -> Rational
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Rational]
xs) (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
stack ([Pattern a] -> Pattern a) -> [Pattern a] -> Pattern a
forall a b. (a -> b) -> a -> b
$ (Arc -> Pattern a) -> [Arc] -> [Pattern a]
forall a b. (a -> b) -> [a] -> [b]
map (Arc -> Pattern a -> Pattern a
forall a. Arc -> Pattern a -> Pattern a
`compressArc` Pattern a
p) [Arc]
spaceArcs
where markOut :: Time -> [Time] -> [Arc]
markOut :: Rational -> [Rational] -> [Arc]
markOut Rational
_ [] = []
markOut Rational
offset (Rational
x:[Rational]
xs') = Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc Rational
offset (Rational
offsetRational -> Rational -> Rational
forall a. Num a => a -> a -> a
+Rational
x)Arc -> [Arc] -> [Arc]
forall a. a -> [a] -> [a]
:Rational -> [Rational] -> [Arc]
markOut (Rational
offsetRational -> Rational -> Rational
forall a. Num a => a -> a -> a
+Rational
x) [Rational]
xs'
spaceArcs :: [Arc]
spaceArcs = (Arc -> Arc) -> [Arc] -> [Arc]
forall a b. (a -> b) -> [a] -> [b]
map (\(Arc Rational
a Rational
b) -> Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc (Rational
aRational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
s) (Rational
bRational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
s)) ([Arc] -> [Arc]) -> [Arc] -> [Arc]
forall a b. (a -> b) -> a -> b
$ Rational -> [Rational] -> [Arc]
markOut Rational
0 [Rational]
xs
s :: Rational
s = [Rational] -> Rational
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Rational]
xs
flatpat :: Pattern [a] -> Pattern a
flatpat :: forall a. Pattern [a] -> Pattern a
flatpat Pattern [a]
p = Pattern [a]
p {query :: State -> [Event a]
query = (EventF Arc [a] -> [Event a]) -> [EventF Arc [a]] -> [Event a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Event Context
c Maybe Arc
b Arc
b' [a]
xs) -> (a -> Event a) -> [a] -> [Event a]
forall a b. (a -> b) -> [a] -> [b]
map (Context -> Maybe Arc -> Arc -> a -> Event a
forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event Context
c Maybe Arc
b Arc
b') [a]
xs) ([EventF Arc [a]] -> [Event a])
-> (State -> [EventF Arc [a]]) -> State -> [Event a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern [a] -> State -> [EventF Arc [a]]
forall a. Pattern a -> State -> [Event a]
query Pattern [a]
p}
layer :: [a -> Pattern b] -> a -> Pattern b
layer :: forall a b. [a -> Pattern b] -> a -> Pattern b
layer [a -> Pattern b]
fs a
p = [Pattern b] -> Pattern b
forall a. [Pattern a] -> Pattern a
stack ([Pattern b] -> Pattern b) -> [Pattern b] -> Pattern b
forall a b. (a -> b) -> a -> b
$ ((a -> Pattern b) -> Pattern b) -> [a -> Pattern b] -> [Pattern b]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> Pattern b) -> a -> Pattern b
forall a b. (a -> b) -> a -> b
$ a
p) [a -> Pattern b]
fs
arpeggiate :: Pattern a -> Pattern a
arpeggiate :: forall a. Pattern a -> Pattern a
arpeggiate = ([EventF Arc a] -> [EventF Arc a]) -> Pattern a -> Pattern a
forall a b.
([EventF Arc a] -> [EventF Arc b]) -> Pattern a -> Pattern b
arpWith [EventF Arc a] -> [EventF Arc a]
forall a. a -> a
id
arpg :: Pattern a -> Pattern a
arpg :: forall a. Pattern a -> Pattern a
arpg = Pattern a -> Pattern a
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 = ([EventF Arc a] -> [EventF Arc b]) -> Pattern a -> Pattern b
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 = ([EventF Arc a] -> [EventF Arc b])
-> [[EventF Arc a]] -> [EventF Arc b]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([EventF Arc b] -> [EventF Arc b]
forall {b}. [EventF Arc b] -> [EventF Arc b]
spreadOut ([EventF Arc b] -> [EventF Arc b])
-> ([EventF Arc a] -> [EventF Arc b])
-> [EventF Arc a]
-> [EventF Arc b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EventF Arc a] -> [EventF Arc b]
f) ((EventF Arc a -> EventF Arc a -> Bool)
-> [EventF Arc a] -> [[EventF Arc a]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\EventF Arc a
a EventF Arc a
b -> EventF Arc a -> Maybe Arc
forall a b. EventF a b -> Maybe a
whole EventF Arc a
a Maybe Arc -> Maybe Arc -> Bool
forall a. Eq a => a -> a -> Bool
== EventF Arc a -> Maybe Arc
forall a b. EventF a b -> Maybe a
whole EventF Arc a
b) ([EventF Arc a] -> [[EventF Arc a]])
-> [EventF Arc a] -> [[EventF Arc a]]
forall a b. (a -> b) -> a -> b
$ (EventF Arc a -> Maybe Arc) -> [EventF Arc a] -> [EventF Arc a]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn EventF Arc a -> Maybe Arc
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 = ((Int, EventF Arc b) -> Maybe (EventF Arc b))
-> [(Int, EventF Arc b)] -> [EventF Arc b]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(Int
n, EventF Arc b
x) -> Int -> Int -> EventF Arc b -> Maybe (EventF Arc b)
forall {p} {p} {b}.
(Integral p, Integral p) =>
p -> p -> EventF Arc b -> Maybe (EventF Arc b)
shiftIt Int
n ([EventF Arc b] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [EventF Arc b]
xs) EventF Arc b
x) ([(Int, EventF Arc b)] -> [EventF Arc b])
-> [(Int, EventF Arc b)] -> [EventF Arc b]
forall a b. (a -> b) -> a -> b
$ [EventF Arc b] -> [(Int, EventF Arc 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 Rational
s Rational
e)) Arc
a' b
v) =
do
Arc
a'' <- Arc -> Arc -> Maybe Arc
subArc (Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc Rational
newS Rational
newE) Arc
a'
EventF Arc b -> Maybe (EventF Arc b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Context -> Maybe Arc -> Arc -> b -> EventF Arc b
forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event Context
c (Arc -> Maybe Arc
forall a. a -> Maybe a
Just (Arc -> Maybe Arc) -> Arc -> Maybe Arc
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc Rational
newS Rational
newE) Arc
a'' b
v)
where newS :: Rational
newS = Rational
s Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ (Rational
dur Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* p -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral p
n)
newE :: Rational
newE = Rational
newS Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
dur
dur :: Rational
dur = (Rational
e Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
s) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ p -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral p
d
shiftIt p
_ p
_ EventF Arc b
_ = Maybe (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 = ([Char] -> Pattern a -> Pattern a)
-> Pattern [Char] -> Pattern a -> Pattern a
forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam [Char] -> Pattern a -> Pattern a
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 = ([EventF Arc a] -> [EventF Arc a]) -> Pattern a -> Pattern a
forall a b.
([EventF Arc a] -> [EventF Arc b]) -> Pattern a -> Pattern b
arpWith [EventF Arc a] -> [EventF Arc a]
forall a. [a] -> [a]
f Pattern a
p
where f :: [a] -> [a]
f = ([a] -> [a]) -> Maybe ([a] -> [a]) -> [a] -> [a]
forall a. a -> Maybe a -> a
fromMaybe [a] -> [a]
forall a. a -> a
id (Maybe ([a] -> [a]) -> [a] -> [a])
-> Maybe ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [Char] -> [([Char], [a] -> [a])] -> Maybe ([a] -> [a])
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
name [([Char], [a] -> [a])]
forall a. [([Char], [a] -> [a])]
arps
arps :: [(String, [a] -> [a])]
arps :: forall a. [([Char], [a] -> [a])]
arps = [([Char]
"up", [a] -> [a]
forall a. a -> a
id),
([Char]
"down", [a] -> [a]
forall a. [a] -> [a]
reverse),
([Char]
"updown", \[a]
x -> [a] -> [a]
forall a. [a] -> [a]
init [a]
x [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. [a] -> [a]
init ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
x)),
([Char]
"downup", \[a]
x -> [a] -> [a]
forall a. [a] -> [a]
init ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
x) [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. [a] -> [a]
init [a]
x),
([Char]
"up&down", \[a]
x -> [a]
x [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. [a] -> [a]
reverse [a]
x),
([Char]
"down&up", \[a]
x -> [a] -> [a]
forall a. [a] -> [a]
reverse [a]
x [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
x),
([Char]
"converge", [a] -> [a]
forall a. [a] -> [a]
converge),
([Char]
"diverge", [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
converge),
([Char]
"disconverge", \[a]
x -> [a] -> [a]
forall a. [a] -> [a]
converge [a]
x [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. [a] -> [a]
tail ([a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
converge [a]
x)),
([Char]
"pinkyup", [a] -> [a]
forall a. [a] -> [a]
pinkyup),
([Char]
"pinkyupdown", \[a]
x -> [a] -> [a]
forall a. [a] -> [a]
init ([a] -> [a]
forall a. [a] -> [a]
pinkyup [a]
x) [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. [a] -> [a]
init ([a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
pinkyup [a]
x)),
([Char]
"thumbup", [a] -> [a]
forall a. [a] -> [a]
thumbup),
([Char]
"thumbupdown", \[a]
x -> [a] -> [a]
forall a. [a] -> [a]
init ([a] -> [a]
forall a. [a] -> [a]
thumbup [a]
x) [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. [a] -> [a]
init ([a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
thumbup [a]
x))
]
converge :: [a] -> [a]
converge [] = []
converge (a
x:[a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
converge' [a]
xs
converge' :: [a] -> [a]
converge' [] = []
converge' [a]
xs = [a] -> a
forall a. [a] -> a
last [a]
xs a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
converge ([a] -> [a]
forall a. [a] -> [a]
init [a]
xs)
pinkyup :: [b] -> [b]
pinkyup [b]
xs = (b -> [b]) -> [b] -> [b]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (b -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b
pinky]) ([b] -> [b]) -> [b] -> [b]
forall a b. (a -> b) -> a -> b
$ [b] -> [b]
forall a. [a] -> [a]
init [b]
xs
where pinky :: b
pinky = [b] -> b
forall a. [a] -> a
last [b]
xs
thumbup :: [b] -> [b]
thumbup [b]
xs = (b -> [b]) -> [b] -> [b]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\b
x -> [b
thumb,b
x]) ([b] -> [b]) -> [b] -> [b]
forall a b. (a -> b) -> a -> b
$ [b] -> [b]
forall a. [a] -> [a]
tail [b]
xs
where thumb :: b
thumb = [b] -> b
forall a. [a] -> a
head [b]
xs
ply :: Pattern Rational -> Pattern a -> Pattern a
ply :: forall a. Pattern Rational -> Pattern a -> Pattern a
ply = (Rational -> Pattern a -> Pattern a)
-> Pattern Rational -> Pattern a -> Pattern a
forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
_ply
_ply :: Rational -> Pattern a -> Pattern a
_ply :: forall a. Rational -> Pattern a -> Pattern a
_ply Rational
n Pattern a
pat = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
squeezeJoin (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ (Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
_fast Rational
n (Pattern a -> Pattern a) -> (a -> Pattern a) -> a -> Pattern a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (a -> Pattern a) -> Pattern a -> Pattern (Pattern a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
pat
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 = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
innerJoin (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ (\t
n -> t -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
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) (t -> Pattern a) -> Pattern t -> Pattern (Pattern a)
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 = Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
arpeggiate (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ t -> Pattern a
forall {t}. (Ord t, Num t) => t -> Pattern a
compound t
numPat
where compound :: t -> Pattern a
compound t
n | t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
1 = Pattern a
p
| Bool
otherwise = Pattern a -> Pattern a -> Pattern a
forall a. Pattern a -> Pattern a -> Pattern a
overlay Pattern a
p (Pattern a -> Pattern a
f (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ t -> Pattern a
compound (t -> Pattern a) -> t -> Pattern a
forall a b. (a -> b) -> a -> b
$ t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1)
press :: Pattern a -> Pattern a
press :: forall a. Pattern a -> Pattern a
press = Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
_pressBy Rational
0.5
pressBy :: Pattern Time -> Pattern a -> Pattern a
pressBy :: forall a. Pattern Rational -> Pattern a -> Pattern a
pressBy = (Rational -> Pattern a -> Pattern a)
-> Pattern Rational -> Pattern a -> Pattern a
forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
_pressBy
_pressBy :: Time -> Pattern a -> Pattern a
_pressBy :: forall a. Rational -> Pattern a -> Pattern a
_pressBy Rational
r Pattern a
pat = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
squeezeJoin (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ ((Rational, Rational) -> Pattern a -> Pattern a
forall a. (Rational, Rational) -> Pattern a -> Pattern a
compressTo (Rational
r,Rational
1) (Pattern a -> Pattern a) -> (a -> Pattern a) -> a -> Pattern a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (a -> Pattern a) -> Pattern a -> Pattern (Pattern a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
pat
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 = Pattern a -> Pattern a -> Pattern a
forall a. Pattern a -> Pattern a -> Pattern a
overlay (Pattern Bool -> Pattern a -> Pattern a
forall a. Pattern Bool -> Pattern a -> Pattern a
mask Pattern Bool
pb Pattern a
a) (Pattern Bool -> Pattern a -> Pattern a
forall a. Pattern Bool -> Pattern a -> Pattern a
mask (Pattern Bool -> Pattern Bool
forall (f :: * -> *). Functor f => f Bool -> f Bool
inv Pattern Bool
pb) Pattern a
b)
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 = Pattern a -> Pattern a -> Pattern a
forall a. Pattern a -> Pattern a -> Pattern a
overlay (Pattern Bool -> Pattern a -> Pattern a
forall a. Pattern Bool -> Pattern a -> Pattern a
struct Pattern Bool
pb Pattern a
a) (Pattern Bool -> Pattern a -> Pattern a
forall a. Pattern Bool -> Pattern a -> Pattern a
struct (Pattern Bool -> Pattern Bool
forall (f :: * -> *). Functor f => f Bool -> f Bool
inv Pattern Bool
pb) Pattern a
b)
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 = Pattern Bool -> Pattern a -> Pattern a -> Pattern a
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 -> Rational -> Pattern a -> Pattern a
stutter i
n Rational
t Pattern a
p = [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
stack ([Pattern a] -> Pattern a) -> [Pattern a] -> Pattern a
forall a b. (a -> b) -> a -> b
$ (i -> Pattern a) -> [i] -> [Pattern a]
forall a b. (a -> b) -> [a] -> [b]
map (\i
i -> (Rational
t Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* i -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
i) Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
`rotR` Pattern a
p) [i
0 .. (i
ni -> i -> i
forall a. Num a => a -> a -> a
-i
1)]
echo, triple, quad, double :: Time -> Pattern a -> Pattern a
echo :: forall a. Rational -> Pattern a -> Pattern a
echo = Int -> Rational -> Pattern a -> Pattern a
forall i a. Integral i => i -> Rational -> Pattern a -> Pattern a
stutter (Int
2 :: Int)
triple :: forall a. Rational -> Pattern a -> Pattern a
triple = Int -> Rational -> Pattern a -> Pattern a
forall i a. Integral i => i -> Rational -> Pattern a -> Pattern a
stutter (Int
3 :: Int)
quad :: forall a. Rational -> Pattern a -> Pattern a
quad = Int -> Rational -> Pattern a -> Pattern a
forall i a. Integral i => i -> Rational -> Pattern a -> Pattern a
stutter (Int
4 :: Int)
double :: forall a. Rational -> Pattern a -> Pattern a
double = Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
echo
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 = [Pattern ValueMap] -> Pattern ValueMap
forall a. [Pattern a] -> Pattern a
stack [Pattern ValueMap
p Pattern ValueMap -> Pattern ValueMap -> Pattern ValueMap
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> Pattern ValueMap
P.pan (Double -> Pattern Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
0) Pattern ValueMap -> Pattern ValueMap -> Pattern ValueMap
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Int -> Pattern ValueMap
P.cut (Int -> Pattern Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (-Int
1)),
Pattern ValueMap -> Pattern ValueMap
f (Pattern ValueMap -> Pattern ValueMap)
-> Pattern ValueMap -> Pattern ValueMap
forall a b. (a -> b) -> a -> b
$ Pattern ValueMap
p Pattern ValueMap -> Pattern ValueMap -> Pattern ValueMap
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> Pattern ValueMap
P.pan (Double -> Pattern Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
1) Pattern ValueMap -> Pattern ValueMap -> Pattern ValueMap
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Int -> Pattern ValueMap
P.cut (Int -> Pattern Int
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 = [Pattern ValueMap] -> Pattern ValueMap
forall a. [Pattern a] -> Pattern a
stack ([Pattern ValueMap] -> Pattern ValueMap)
-> [Pattern ValueMap] -> Pattern ValueMap
forall a b. (a -> b) -> a -> b
$ (Int -> Pattern ValueMap) -> [Int] -> [Pattern ValueMap]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
n -> (([t -> Pattern ValueMap]
fs [t -> Pattern ValueMap] -> Int -> t -> Pattern ValueMap
forall a. [a] -> Int -> a
!! Int
n) t
p Pattern ValueMap -> Pattern ValueMap -> Pattern ValueMap
forall a. Num a => Pattern a -> Pattern a -> Pattern a
|+ Pattern Int -> Pattern ValueMap
P.cut (Int -> Pattern Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Pattern Int) -> Int -> Pattern Int
forall a b. (a -> b) -> a -> b
$ Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n)) Pattern ValueMap -> Pattern ValueMap -> Pattern ValueMap
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> Pattern ValueMap
P.pan (Double -> Pattern Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Pattern Double) -> Double -> Pattern Double
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)) [Int
0 .. Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
where l :: Int
l = [t -> Pattern ValueMap] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [t -> Pattern ValueMap]
fs
jux' :: [t -> Pattern ValueMap] -> t -> Pattern ValueMap
jux' :: forall t. [t -> Pattern ValueMap] -> t -> Pattern ValueMap
jux' [t -> Pattern ValueMap]
fs t
p = [Pattern ValueMap] -> Pattern ValueMap
forall a. [Pattern a] -> Pattern a
stack ([Pattern ValueMap] -> Pattern ValueMap)
-> [Pattern ValueMap] -> Pattern ValueMap
forall a b. (a -> b) -> a -> b
$ (Int -> Pattern ValueMap) -> [Int] -> [Pattern ValueMap]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
n -> ([t -> Pattern ValueMap]
fs [t -> Pattern ValueMap] -> Int -> t -> Pattern ValueMap
forall a. [a] -> Int -> a
!! Int
n) t
p Pattern ValueMap -> Pattern ValueMap -> Pattern ValueMap
forall a. Num a => Pattern a -> Pattern a -> Pattern a
|+ Pattern Double -> Pattern ValueMap
P.pan (Double -> Pattern Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Pattern Double) -> Double -> Pattern Double
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)) [Int
0 .. Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
where l :: Int
l = [t -> Pattern ValueMap] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [t -> Pattern ValueMap]
fs
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 = [Pattern ValueMap] -> Pattern ValueMap
forall a. [Pattern a] -> Pattern a
stack [Pattern ValueMap
p Pattern ValueMap -> Pattern ValueMap -> Pattern ValueMap
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> Pattern ValueMap
P.pan (Double -> Pattern Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double
5Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
8)), Pattern ValueMap -> Pattern ValueMap
f (Pattern ValueMap -> Pattern ValueMap)
-> Pattern ValueMap -> Pattern ValueMap
forall a b. (a -> b) -> a -> b
$ Pattern ValueMap
p Pattern ValueMap -> Pattern ValueMap -> Pattern ValueMap
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> Pattern ValueMap
P.pan (Double -> Pattern Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
8))]
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 = [Pattern ValueMap] -> Pattern ValueMap
forall a. [Pattern a] -> Pattern a
stack [Pattern ValueMap
p Pattern ValueMap -> Pattern ValueMap -> Pattern ValueMap
forall a. Num a => Pattern a -> Pattern a -> Pattern a
|+ Pattern Double -> Pattern ValueMap
P.pan Pattern Double
0.5 Pattern ValueMap -> Pattern ValueMap -> Pattern ValueMap
forall a. Num a => Pattern a -> Pattern a -> Pattern a
|- Pattern Double -> Pattern ValueMap
P.pan (Pattern Double
nPattern Double -> Pattern Double -> Pattern Double
forall a. Fractional a => a -> a -> a
/Pattern Double
2), Pattern ValueMap -> Pattern ValueMap
f (Pattern ValueMap -> Pattern ValueMap)
-> Pattern ValueMap -> Pattern ValueMap
forall a b. (a -> b) -> a -> b
$ Pattern ValueMap
p Pattern ValueMap -> Pattern ValueMap -> Pattern ValueMap
forall a. Num a => Pattern a -> Pattern a -> Pattern a
|+ Pattern Double -> Pattern ValueMap
P.pan Pattern Double
0.5 Pattern ValueMap -> Pattern ValueMap -> Pattern ValueMap
forall a. Num a => Pattern a -> Pattern a -> Pattern a
|+ Pattern Double -> Pattern ValueMap
P.pan (Pattern Double
nPattern Double -> Pattern Double -> Pattern Double
forall a. Fractional a => a -> a -> a
/Pattern Double
2)]
pick :: String -> Int -> String
pick :: [Char] -> Int -> [Char]
pick [Char]
name Int
n = [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n
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 ([Char] -> Int -> [Char]) -> f [Char] -> f (Int -> [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f [Char]
p f (Int -> [Char]) -> f Int -> f [Char]
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' = ([Char] -> Int -> [Char]) -> Int -> [Char] -> [Char]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Char] -> Int -> [Char]
pick (Int -> [Char] -> [Char]) -> f Int -> f ([Char] -> [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Int
p' f ([Char] -> [Char]) -> f [Char] -> f [Char]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f [Char]
p
spreadf :: [a -> Pattern b] -> a -> Pattern b
spreadf :: forall a b. [a -> Pattern b] -> a -> Pattern b
spreadf = ((a -> Pattern b) -> a -> Pattern b)
-> [a -> Pattern b] -> a -> Pattern b
forall a t b. (a -> t -> Pattern b) -> [a] -> t -> Pattern b
spread (a -> Pattern b) -> a -> Pattern b
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 | [Pattern a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Pattern a]
ps = Pattern a
forall a. Pattern a
silence
| Bool
otherwise = [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
stack ([Pattern a] -> Pattern a) -> [Pattern a] -> Pattern a
forall a b. (a -> b) -> a -> b
$ ((Int, Pattern a) -> Pattern a)
-> [(Int, Pattern a)] -> [Pattern a]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
i, Pattern a
p') -> Pattern a
p' Pattern a -> Pattern a -> Pattern a
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# ((Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
l) Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
`rotL` Pattern a
p)) ([Int] -> [Pattern a] -> [(Int, Pattern a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0::Int ..] [Pattern a]
ps)
where l :: Integer
l = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ [Pattern a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pattern a]
ps
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 a -> a -> a
forall a. Num a => a -> a -> a
* (a
toa -> a -> a
forall a. Num a => a -> a -> a
-a
from)) a -> a -> a
forall a. Num a => a -> a -> a
+ a
from)) (a -> a -> a -> a) -> Pattern a -> Pattern (a -> a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
fromP Pattern (a -> a -> a) -> Pattern a -> Pattern (a -> a)
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
*> Pattern a
toP Pattern (a -> a) -> Pattern a -> Pattern a
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 = (b -> b -> b
forall a. Num a => a -> a -> a
+ b
from) (b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> b -> b
forall a. Num a => a -> a -> a
* (b
tob -> b -> b
forall a. Num a => a -> a -> a
-b
from)) (b -> b) -> f b -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
p
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 = b -> b
forall {a}. Floating a => a -> a
exp (b -> b) -> f b -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> b -> f b -> f b
forall (f :: * -> *) b. (Functor f, Num b) => b -> b -> f b -> f b
_range (b -> b
forall {a}. Floating a => a -> a
log b
from) (b -> b
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 Rational
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
off Pattern Rational
tp Pattern a -> Pattern a
f Pattern a
p = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
innerJoin (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ (\Rational
tv -> Rational -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a.
Rational -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_off Rational
tv Pattern a -> Pattern a
f Pattern a
p) (Rational -> Pattern a) -> Pattern Rational -> Pattern (Pattern a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Rational
tp
_off :: Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_off :: forall a.
Rational -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_off Rational
t Pattern a -> Pattern a
f Pattern a
p = (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a. (Pattern a -> Pattern a) -> Pattern a -> Pattern a
superimpose (Pattern a -> Pattern a
f (Pattern a -> Pattern a)
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational
t Rational -> Pattern a -> Pattern a
forall a. Rational -> 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 Rational -> Pattern a -> Pattern a -> Pattern a
offadd Pattern Rational
tp Pattern a
pn Pattern a
p = Pattern Rational
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a.
Pattern Rational
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
off Pattern Rational
tp (Pattern a -> Pattern a -> Pattern a
forall a. Num a => a -> a -> a
+Pattern a
pn) Pattern a
p
step :: String -> String -> Pattern String
step :: [Char] -> [Char] -> Pattern [Char]
step [Char]
s [Char]
cs = [Pattern [Char]] -> Pattern [Char]
forall a. [Pattern a] -> Pattern a
fastcat ([Pattern [Char]] -> Pattern [Char])
-> [Pattern [Char]] -> Pattern [Char]
forall a b. (a -> b) -> a -> b
$ (Char -> Pattern [Char]) -> [Char] -> [Pattern [Char]]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Pattern [Char]
f [Char]
cs
where f :: Char -> Pattern [Char]
f Char
c | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'x' = [Char] -> Pattern [Char]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
s
| Char -> Bool
isDigit Char
c = [Char] -> Pattern [Char]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> Pattern [Char]) -> [Char] -> Pattern [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
c]
| Bool
otherwise = Pattern [Char]
forall a. Pattern a
silence
steps :: [(String, String)] -> Pattern String
steps :: [([Char], [Char])] -> Pattern [Char]
steps = [Pattern [Char]] -> Pattern [Char]
forall a. [Pattern a] -> Pattern a
stack ([Pattern [Char]] -> Pattern [Char])
-> ([([Char], [Char])] -> [Pattern [Char]])
-> [([Char], [Char])]
-> Pattern [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Char], [Char]) -> Pattern [Char])
-> [([Char], [Char])] -> [Pattern [Char]]
forall a b. (a -> b) -> [a] -> [b]
map (([Char] -> [Char] -> Pattern [Char])
-> ([Char], [Char]) -> Pattern [Char]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Char] -> [Char] -> Pattern [Char]
step)
step' :: [String] -> String -> Pattern String
step' :: [[Char]] -> [Char] -> Pattern [Char]
step' [[Char]]
ss [Char]
cs = [Pattern [Char]] -> Pattern [Char]
forall a. [Pattern a] -> Pattern a
fastcat ([Pattern [Char]] -> Pattern [Char])
-> [Pattern [Char]] -> Pattern [Char]
forall a b. (a -> b) -> a -> b
$ (Char -> Pattern [Char]) -> [Char] -> [Pattern [Char]]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Pattern [Char]
f [Char]
cs
where f :: Char -> Pattern [Char]
f Char
c | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'x' = [Char] -> Pattern [Char]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> Pattern [Char]) -> [Char] -> Pattern [Char]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall a. [a] -> a
head [[Char]]
ss
| Char -> Bool
isDigit Char
c = [Char] -> Pattern [Char]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> Pattern [Char]) -> [Char] -> Pattern [Char]
forall a b. (a -> b) -> a -> b
$ [[Char]]
ss [[Char]] -> Int -> [Char]
forall a. [a] -> Int -> a
!! Char -> Int
digitToInt Char
c
| Bool
otherwise = Pattern [Char]
forall a. Pattern a
silence
ghost'' :: Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
ghost'' :: forall a.
Rational -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
ghost'' Rational
a Pattern a -> Pattern a
f Pattern a
p = (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a. (Pattern a -> Pattern a) -> Pattern a -> Pattern a
superimpose (((Rational
aRational -> Rational -> Rational
forall a. Num a => a -> a -> a
*Rational
2.5) Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
`rotR`) (Pattern a -> Pattern a)
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern a -> Pattern a
f) (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a. (Pattern a -> Pattern a) -> Pattern a -> Pattern a
superimpose (((Rational
aRational -> Rational -> Rational
forall a. Num a => a -> a -> a
*Rational
1.5) Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
`rotR`) (Pattern a -> Pattern a)
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
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' :: Rational -> Pattern ValueMap -> Pattern ValueMap
ghost' Rational
a Pattern ValueMap
p = Rational
-> (Pattern ValueMap -> Pattern ValueMap)
-> Pattern ValueMap
-> Pattern ValueMap
forall a.
Rational -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
ghost'' Rational
a ((Pattern ValueMap -> Pattern ValueMap -> Pattern ValueMap
forall (a :: * -> *) b. (Applicative a, Num b) => a b -> a b -> a b
|*| Pattern Double -> Pattern ValueMap
P.gain (Double -> Pattern Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
0.7)) (Pattern ValueMap -> Pattern ValueMap)
-> (Pattern ValueMap -> Pattern ValueMap)
-> Pattern ValueMap
-> Pattern ValueMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pattern ValueMap -> Pattern ValueMap -> Pattern ValueMap
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
|> Pattern Double -> Pattern ValueMap
P.end (Double -> Pattern Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
0.2)) (Pattern ValueMap -> Pattern ValueMap)
-> (Pattern ValueMap -> Pattern ValueMap)
-> Pattern ValueMap
-> Pattern ValueMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pattern ValueMap -> Pattern ValueMap -> Pattern ValueMap
forall (a :: * -> *) b. (Applicative a, Num b) => a b -> a b -> a b
|*| Pattern Double -> Pattern ValueMap
P.speed (Double -> Pattern Double
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 = Rational -> Pattern ValueMap -> Pattern ValueMap
ghost' Rational
0.125
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' = [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
stack [Pattern a
maskedWarp,
Pattern a
maskedWeft
]
where
n :: Integer
n = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nInt
weft :: [[Integer]]
weft = (Integer -> [[Integer]]) -> [Integer] -> [[Integer]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([[Integer]] -> Integer -> [[Integer]]
forall a b. a -> b -> a
const [[Integer
0..Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1], [Integer] -> [Integer]
forall a. [a] -> [a]
reverse [Integer
0..Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1]]) [Integer
0 .. (Integer
n Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
2) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1]
warp :: [[Integer]]
warp = [[Integer]] -> [[Integer]]
forall a. [[a]] -> [[a]]
transpose [[Integer]]
weft
thread :: t [Integer] -> Pattern a -> Pattern a
thread t [Integer]
xs Pattern a
p'' = Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
_slow (Integer
nInteger -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
1) (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
fastcat ([Pattern a] -> Pattern a) -> [Pattern a] -> Pattern a
forall a b. (a -> b) -> a -> b
$ (Integer -> Pattern a) -> [Integer] -> [Pattern a]
forall a b. (a -> b) -> [a] -> [b]
map (\Integer
i -> Arc -> Pattern a -> Pattern a
forall a. Arc -> Pattern a -> Pattern a
zoomArc (Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc (Integer
iInteger -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
n) ((Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1)Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
n)) Pattern a
p'') (t [Integer] -> [Integer]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat t [Integer]
xs)
weftP :: Pattern a
weftP = [[Integer]] -> Pattern a -> Pattern a
forall {t :: * -> *} {a}.
Foldable t =>
t [Integer] -> Pattern a -> Pattern a
thread [[Integer]]
weft Pattern a
p'
warpP :: Pattern a
warpP = [[Integer]] -> Pattern a -> Pattern a
forall {t :: * -> *} {a}.
Foldable t =>
t [Integer] -> Pattern a -> Pattern a
thread [[Integer]]
warp Pattern a
p
maskedWeft :: Pattern a
maskedWeft = Pattern Bool -> Pattern a -> Pattern a
forall a. Pattern Bool -> Pattern a -> Pattern a
mask (Pattern Int
-> (Pattern Bool -> Pattern Bool) -> Pattern Bool -> Pattern Bool
forall b.
Pattern Int -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b
every Pattern Int
2 Pattern Bool -> Pattern Bool
forall a. Pattern a -> Pattern a
rev (Pattern Bool -> Pattern Bool) -> Pattern Bool -> Pattern Bool
forall a b. (a -> b) -> a -> b
$ Rational -> Pattern Bool -> Pattern Bool
forall a. Rational -> Pattern a -> Pattern a
_fast (Integer
n Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
2) (Pattern Bool -> Pattern Bool) -> Pattern Bool -> Pattern Bool
forall a b. (a -> b) -> a -> b
$ [Pattern Bool] -> Pattern Bool
forall a. [Pattern a] -> Pattern a
fastCat [Pattern Bool
forall a. Pattern a
silence, Bool -> Pattern Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True]) Pattern a
weftP
maskedWarp :: Pattern a
maskedWarp = Pattern Bool -> Pattern a -> Pattern a
forall a. Pattern Bool -> Pattern a -> Pattern a
mask (Pattern Int
-> (Pattern Bool -> Pattern Bool) -> Pattern Bool -> Pattern Bool
forall b.
Pattern Int -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b
every Pattern Int
2 Pattern Bool -> Pattern Bool
forall a. Pattern a -> Pattern a
rev (Pattern Bool -> Pattern Bool) -> Pattern Bool -> Pattern Bool
forall a b. (a -> b) -> a -> b
$ Rational -> Pattern Bool -> Pattern Bool
forall a. Rational -> Pattern a -> Pattern a
_fast (Integer
n Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
2) (Pattern Bool -> Pattern Bool) -> Pattern Bool -> Pattern Bool
forall a b. (a -> b) -> a -> b
$ [Pattern Bool] -> Pattern Bool
forall a. [Pattern a] -> Pattern a
fastCat [Bool -> Pattern Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True, Pattern Bool
forall a. Pattern a
silence]) Pattern a
warpP
select :: Pattern Double -> [Pattern a] -> Pattern a
select :: forall a. Pattern Double -> [Pattern a] -> Pattern a
select = (Double -> [Pattern a] -> Pattern a)
-> Pattern Double -> [Pattern a] -> Pattern a
forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam Double -> [Pattern a] -> Pattern a
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 [Pattern a] -> Int -> Pattern a
forall a. [a] -> Int -> a
!! Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
1 Double
f) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Pattern a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pattern a]
ps Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
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 = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
innerJoin (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ (\Double
f -> Double -> [Pattern a -> Pattern a] -> Pattern a -> Pattern a
forall a.
Double -> [Pattern a -> Pattern a] -> Pattern a -> Pattern a
_selectF Double
f [Pattern a -> Pattern a]
ps Pattern a
p) (Double -> Pattern a) -> Pattern Double -> Pattern (Pattern a)
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 [Pattern a -> Pattern a] -> Int -> Pattern a -> Pattern a
forall a. [a] -> Int -> a
!! Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
0.999999 Double
f) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Pattern a -> Pattern a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pattern a -> Pattern a]
ps))) Pattern a
p
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 = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
innerJoin (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ (\Int
i -> Int -> [Pattern a -> Pattern a] -> Pattern a -> Pattern a
forall a. Int -> [Pattern a -> Pattern a] -> Pattern a -> Pattern a
_pickF Int
i [Pattern a -> Pattern a]
fs Pattern a
pat) (Int -> Pattern a) -> Pattern Int -> Pattern (Pattern a)
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 [Pattern a -> Pattern a] -> Int -> Pattern a -> Pattern a
forall a. [a] -> Int -> a
!!! Int
i) Pattern a
p
contrast :: (ControlPattern -> ControlPattern) -> (ControlPattern -> ControlPattern)
-> ControlPattern -> ControlPattern -> ControlPattern
contrast :: (Pattern ValueMap -> Pattern ValueMap)
-> (Pattern ValueMap -> Pattern ValueMap)
-> Pattern ValueMap
-> Pattern ValueMap
-> Pattern ValueMap
contrast = (Value -> Value -> Bool)
-> (Pattern ValueMap -> Pattern ValueMap)
-> (Pattern ValueMap -> Pattern ValueMap)
-> Pattern ValueMap
-> Pattern ValueMap
-> Pattern ValueMap
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 -> Bool
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' = Pattern b -> Pattern b -> Pattern b
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 = (ValueMap -> Map [Char] a -> Bool)
-> Pattern (Map [Char] a)
-> Pattern ValueMap
-> Pattern (Bool, ValueMap)
forall b a.
(b -> a -> Bool) -> Pattern a -> Pattern b -> Pattern (Bool, b)
matchManyToOne ((Map [Char] a -> ValueMap -> Bool)
-> ValueMap -> Map [Char] a -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Map [Char] a -> ValueMap -> Bool)
-> ValueMap -> Map [Char] a -> Bool)
-> (Map [Char] a -> ValueMap -> Bool)
-> ValueMap
-> Map [Char] a
-> Bool
forall a b. (a -> b) -> a -> b
$ (a -> Value -> Bool) -> Map [Char] a -> ValueMap -> Bool
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 = Pattern (Maybe ValueMap) -> Pattern ValueMap
forall a. Pattern (Maybe a) -> Pattern a
filterJust (Pattern (Maybe ValueMap) -> Pattern ValueMap)
-> Pattern (Maybe ValueMap) -> Pattern ValueMap
forall a b. (a -> b) -> a -> b
$ (\(Bool
t, ValueMap
a) -> if Bool
t then ValueMap -> Maybe ValueMap
forall a. a -> Maybe a
Just ValueMap
a else Maybe ValueMap
forall a. Maybe a
Nothing) ((Bool, ValueMap) -> Maybe ValueMap)
-> Pattern (Bool, ValueMap) -> Pattern (Maybe ValueMap)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern (Bool, ValueMap)
matches
unmatched :: ControlPattern
unmatched :: Pattern ValueMap
unmatched = Pattern (Maybe ValueMap) -> Pattern ValueMap
forall a. Pattern (Maybe a) -> Pattern a
filterJust (Pattern (Maybe ValueMap) -> Pattern ValueMap)
-> Pattern (Maybe ValueMap) -> Pattern ValueMap
forall a b. (a -> b) -> a -> b
$ (\(Bool
t, ValueMap
a) -> if Bool -> Bool
not Bool
t then ValueMap -> Maybe ValueMap
forall a. a -> Maybe a
Just ValueMap
a else Maybe ValueMap
forall a. Maybe a
Nothing) ((Bool, ValueMap) -> Maybe ValueMap)
-> Pattern (Bool, ValueMap) -> Pattern (Maybe ValueMap)
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 = ((Value, Value) -> Value -> Bool)
-> (Pattern ValueMap -> Pattern a)
-> (Pattern ValueMap -> Pattern a)
-> Pattern (Map [Char] (Value, Value))
-> Pattern ValueMap
-> Pattern a
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
s Bool -> Bool -> Bool
&& Int
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
e
f (VF Double
s, VF Double
e) (VF Double
v) = Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
s Bool -> Bool -> Bool
&& Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
e
f (VN Note
s, VN Note
e) (VN Note
v) = Note
v Note -> Note -> Bool
forall a. Ord a => a -> a -> Bool
>= Note
s Bool -> Bool -> Bool
&& Note
v Note -> Note -> Bool
forall a. Ord a => a -> a -> Bool
<= Note
e
f (VS [Char]
s, VS [Char]
e) (VS [Char]
v) = [Char]
v [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
s Bool -> Bool -> Bool
&& [Char]
v [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
e
f (Value, Value)
_ Value
_ = Bool
False
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 Pattern ValueMap -> Pattern ValueMap
forall a. a -> a
id
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 Pattern ValueMap -> Pattern ValueMap
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 = (Pattern ValueMap -> Pattern ValueMap)
-> (Pattern ValueMap -> Pattern ValueMap)
-> Pattern (Map [Char] (Value, Value))
-> Pattern ValueMap
-> Pattern ValueMap
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 Pattern ValueMap -> Pattern ValueMap
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 = (Pattern ValueMap -> Pattern ValueMap)
-> (Pattern ValueMap -> Pattern ValueMap)
-> Pattern (Map [Char] (Value, Value))
-> Pattern ValueMap
-> Pattern ValueMap
forall a.
(Pattern ValueMap -> Pattern a)
-> (Pattern ValueMap -> Pattern a)
-> Pattern (Map [Char] (Value, Value))
-> Pattern ValueMap
-> Pattern a
contrastRange Pattern ValueMap -> Pattern ValueMap
forall a. a -> a
id
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 = (b -> b) -> f b -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> b -> b
forall a. Fractional a => a -> a -> a
/b
n) (b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall {b}. RealFrac b => Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: RealFrac b => Int -> b) (Int -> b) -> (b -> Int) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (b -> Int) -> (b -> b) -> b -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> b -> b
forall a. Num a => a -> a -> a
*b
n))
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 = (b -> b) -> f b -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> b -> b
forall a. Fractional a => a -> a -> a
/b
n) (b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall {b}. RealFrac b => Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: RealFrac b => Int -> b) (Int -> b) -> (b -> Int) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (b -> Int) -> (b -> b) -> b -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> b -> b
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 = (b -> b) -> f b -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> b -> b
forall a. Fractional a => a -> a -> a
/b
n) (b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall {b}. RealFrac b => Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: RealFrac b => Int -> b) (Int -> b) -> (b -> Int) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (b -> Int) -> (b -> b) -> b -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> b -> b
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 = b -> f b -> f b
forall (f :: * -> *) b. (Functor f, RealFrac b) => b -> f b -> f b
quantise
inv :: Functor f => f Bool -> f Bool
inv :: forall (f :: * -> *). Functor f => f Bool -> f Bool
inv = (Bool -> Bool
not (Bool -> Bool) -> f Bool -> f Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
mono :: Pattern a -> Pattern a
mono :: forall a. Pattern a -> Pattern a
mono Pattern a
p = (State -> [Event a]) -> Pattern a
forall a. (State -> [Event a]) -> Pattern a
Pattern ((State -> [Event a]) -> Pattern a)
-> (State -> [Event a]) -> Pattern a
forall a b. (a -> b) -> a -> b
$ \(State Arc
a ValueMap
cm) -> [Event a] -> [Event a]
forall {b}. [EventF Arc b] -> [EventF Arc b]
flatten ([Event a] -> [Event a]) -> [Event a] -> [Event a]
forall a b. (a -> b) -> a -> b
$ Pattern a -> State -> [Event a]
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 = (Event a -> Maybe (Event a)) -> [Event a] -> [Event a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Event a -> Maybe (Event a)
forall a. Event a -> Maybe (Event a)
constrainPart ([Event a] -> [Event a])
-> ([Event a] -> [Event a]) -> [Event a] -> [Event a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Event a] -> [Event a]
forall {b}. [EventF Arc b] -> [EventF Arc b]
truncateOverlaps ([Event a] -> [Event a])
-> ([Event a] -> [Event a]) -> [Event a] -> [Event a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Event a -> Maybe Arc) -> [Event a] -> [Event a]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Event a -> Maybe Arc
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 Event a -> [Event a] -> [Event a]
forall a. a -> [a] -> [a]
: [Event a] -> [Event a]
truncateOverlaps ((Event a -> Maybe (Event a)) -> [Event a] -> [Event a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Event a -> Event a -> Maybe (Event a)
forall {a} {a}. Event a -> Event a -> Maybe (Event a)
snip Event a
e) [Event a]
es)
snip :: Event a -> Event a -> Maybe (Event a)
snip Event a
a Event a
b | Arc -> Rational
forall a. ArcF a -> a
start (Event a -> Arc
forall a. Event a -> Arc
wholeOrPart Event a
b) Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>= Arc -> Rational
forall a. ArcF a -> a
stop (Event a -> Arc
forall a. Event a -> Arc
wholeOrPart Event a
a) = Event a -> Maybe (Event a)
forall a. a -> Maybe a
Just Event a
b
| Arc -> Rational
forall a. ArcF a -> a
stop (Event a -> Arc
forall a. Event a -> Arc
wholeOrPart Event a
b) Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
<= Arc -> Rational
forall a. ArcF a -> a
stop (Event a -> Arc
forall a. Event a -> Arc
wholeOrPart Event a
a) = Maybe (Event a)
forall a. Maybe a
Nothing
| Bool
otherwise = Event a -> Maybe (Event a)
forall a. a -> Maybe a
Just Event a
b {whole :: Maybe Arc
whole = Arc -> Maybe Arc
forall a. a -> Maybe a
Just (Arc -> Maybe Arc) -> Arc -> Maybe Arc
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc (Arc -> Rational
forall a. ArcF a -> a
stop (Arc -> Rational) -> Arc -> Rational
forall a b. (a -> b) -> a -> b
$ Event a -> Arc
forall a. Event a -> Arc
wholeOrPart Event a
a) (Arc -> Rational
forall a. ArcF a -> a
stop (Arc -> Rational) -> Arc -> Rational
forall a b. (a -> b) -> a -> b
$ Event a -> Arc
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 (Event a -> Arc
forall a. Event a -> Arc
wholeOrPart Event a
e) (Event a -> Arc
forall a b. EventF a b -> a
part Event a
e)
Event a -> Maybe (Event a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Event a -> Maybe (Event a)) -> Event a -> Maybe (Event a)
forall a b. (a -> b) -> a -> b
$ Event a
e {part :: Arc
part = Arc
a}
smooth :: Fractional a => Pattern a -> Pattern a
smooth :: forall a. Fractional a => Pattern a -> Pattern a
smooth Pattern a
p = (State -> [Event a]) -> Pattern a
forall a. (State -> [Event a]) -> Pattern a
Pattern ((State -> [Event a]) -> Pattern a)
-> (State -> [Event a]) -> Pattern a
forall a b. (a -> b) -> a -> b
$ \st :: State
st@(State Arc
a ValueMap
cm) -> State -> Arc -> [Event a] -> [Event a]
forall {a}. State -> a -> [Event a] -> [EventF a a]
tween State
st Arc
a ([Event a] -> [Event a]) -> [Event a] -> [Event a]
forall a b. (a -> b) -> a -> b
$ Pattern a -> State -> [Event a]
forall a. Pattern a -> State -> [Event a]
query Pattern a
monoP (Arc -> ValueMap -> State
State (Arc -> Arc
forall {a}. Fractional a => ArcF a -> ArcF a
midArc Arc
a) ValueMap
cm)
where
midArc :: ArcF a -> ArcF a
midArc ArcF a
a = a -> a -> ArcF a
forall a. a -> a -> ArcF a
Arc ((a, a) -> a
forall a. Fractional a => (a, a) -> a
mid (ArcF a -> a
forall a. ArcF a -> a
start ArcF a
a, ArcF a -> a
forall a. ArcF a -> a
stop ArcF a
a)) ((a, a) -> a
forall a. Fractional a => (a, a) -> a
mid (ArcF a -> a
forall a. ArcF a -> a
start ArcF a
a, 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]
_) = [EventF a a] -> (a -> [EventF a a]) -> Maybe a -> [EventF a a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Event a
e {whole :: Maybe a
whole = a -> Maybe a
forall a. a -> Maybe a
Just a
queryA, part :: a
part = a
queryA}] (a -> a -> [EventF a a]
forall {a}. a -> a -> [EventF a a]
tween' a
queryA) (State -> Maybe a
nextV State
st)
where aStop :: Arc
aStop = Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc (Event a -> Rational
forall a. Event a -> Rational
wholeStop Event a
e) (Event a -> Rational
forall a. Event a -> Rational
wholeStop Event a
e)
nextEs :: State -> [Event a]
nextEs State
st' = Pattern a -> State -> [Event a]
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' | [Event a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (State -> [Event a]
nextEs State
st') = Maybe a
forall a. Maybe a
Nothing
| Bool
otherwise = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Event a -> a
forall a b. EventF a b -> b
value ([Event a] -> Event a
forall a. [a] -> a
head (State -> [Event a]
nextEs State
st'))
tween' :: a -> a -> [EventF a a]
tween' a
queryA' a
v =
[ Event :: forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event
{ context :: Context
context = Event a -> Context
forall a b. EventF a b -> Context
context Event a
e,
whole :: Maybe a
whole = a -> Maybe a
forall a. a -> Maybe a
Just a
queryA'
, part :: a
part = a
queryA'
, value :: a
value = Event a -> a
forall a b. EventF a b -> b
value Event a
e a -> a -> a
forall a. Num a => a -> a -> a
+ ((a
v a -> a -> a
forall a. Num a => a -> a -> a
- Event a -> a
forall a b. EventF a b -> b
value Event a
e) a -> a -> a
forall a. Num a => a -> a -> a
* a
pc)}
]
pc :: a
pc | Arc -> Rational
forall {a}. Num a => ArcF a -> a
delta' (Event a -> Arc
forall a. Event a -> Arc
wholeOrPart Event a
e) Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
0 = a
0
| Bool
otherwise = Rational -> a
forall a. Fractional a => Rational -> a
fromRational (Rational -> a) -> Rational -> a
forall a b. (a -> b) -> a -> b
$ (Event a -> Rational
forall a. Event a -> Rational
eventPartStart Event a
e Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Event a -> Rational
forall a. Event a -> Rational
wholeStart Event a
e) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Arc -> Rational
forall {a}. Num a => ArcF a -> a
delta' (Event a -> Arc
forall a. Event a -> Arc
wholeOrPart Event a
e)
delta' :: ArcF a -> a
delta' ArcF a
a = ArcF a -> a
forall a. ArcF a -> a
stop ArcF a
a a -> a -> a
forall a. Num a => a -> a -> a
- ArcF a -> a
forall a. ArcF a -> a
start ArcF a
a
monoP :: Pattern a
monoP = Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
mono Pattern a
p
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 = Pattern (Maybe b) -> Pattern b
forall a. Pattern (Maybe a) -> Pattern a
filterJust (Pattern (Maybe b) -> Pattern b) -> Pattern (Maybe b) -> Pattern b
forall a b. (a -> b) -> a -> b
$ (a -> [(a, b)] -> Maybe b
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(a, b)]
things) (a -> Maybe b) -> Pattern a -> Pattern (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
p
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 = [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
cat ([Pattern a] -> Pattern a) -> [Pattern a] -> Pattern a
forall a b. (a -> b) -> a -> b
$ Int -> [Pattern a] -> [Pattern a]
forall a. Int -> [a] -> [a]
take Int
depth ([Pattern a] -> [Pattern a]) -> [Pattern a] -> [Pattern a]
forall a b. (a -> b) -> a -> b
$ (Pattern a -> Pattern a -> Pattern a)
-> Pattern a -> [Pattern a] -> [Pattern a]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Pattern a -> Pattern a -> Pattern a
combinationFunction Pattern a
pattern ([Pattern a] -> [Pattern a]) -> [Pattern a] -> [Pattern a]
forall a b. (a -> b) -> a -> b
$ Int -> [Pattern a] -> [Pattern a]
forall a. Int -> [a] -> [a]
drop Int
1 ([Pattern a] -> [Pattern a]) -> [Pattern a] -> [Pattern a]
forall a b. (a -> b) -> a -> b
$ (Pattern a -> Pattern a) -> Pattern a -> [Pattern a]
forall a. (a -> a) -> a -> [a]
iterate Pattern a -> Pattern a
f Pattern a
pattern
soak :: Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
soak :: forall b. Int -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b
soak Int
depth Pattern a -> Pattern a
f Pattern a
pattern = [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
cat ([Pattern a] -> Pattern a) -> [Pattern a] -> Pattern a
forall a b. (a -> b) -> a -> b
$ Int -> [Pattern a] -> [Pattern a]
forall a. Int -> [a] -> [a]
take Int
depth ([Pattern a] -> [Pattern a]) -> [Pattern a] -> [Pattern a]
forall a b. (a -> b) -> a -> b
$ (Pattern a -> Pattern a) -> Pattern a -> [Pattern a]
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 = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
" " ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ([[Char]] -> [Char]) -> [[[Char]]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map [[Char]] -> [Char]
showStep ([[[Char]]] -> [[Char]]) -> [[[Char]]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ Pattern [Char] -> [[[Char]]]
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]
"[" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " [[Char]]
xs) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"]"
toList :: Pattern a -> [[a]]
toList :: forall a. Pattern a -> [[a]]
toList Pattern a
pat = ((Rational, Rational) -> [a]) -> [(Rational, Rational)] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (\(Rational
s,Rational
e) -> (EventF Arc a -> a) -> [EventF Arc a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map EventF Arc a -> a
forall a b. EventF a b -> b
value ([EventF Arc a] -> [a]) -> [EventF Arc a] -> [a]
forall a b. (a -> b) -> a -> b
$ Pattern a -> Arc -> [EventF Arc a]
forall a. Pattern a -> Arc -> [Event a]
queryArc (Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
_segment Rational
n' Pattern a
pat) (Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc Rational
s Rational
e)) [(Rational, Rational)]
arcs
where breaks :: [Rational]
breaks = [Rational
0, (Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
n') ..]
arcs :: [(Rational, Rational)]
arcs = [Rational] -> [Rational] -> [(Rational, Rational)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> [Rational] -> [Rational]
forall a. Int -> [a] -> [a]
take Int
n [Rational]
breaks) (Int -> [Rational] -> [Rational]
forall a. Int -> [a] -> [a]
drop Int
1 [Rational]
breaks)
n' :: Rational
n' = Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
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 = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
innerJoin (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ (\Int
n -> Int -> Pattern Int -> Pattern a -> Pattern a
forall a. Int -> Pattern Int -> Pattern a -> Pattern a
_bite Int
n Pattern Int
ipat Pattern a
pat) (Int -> Pattern a) -> Pattern Int -> Pattern (Pattern a)
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 = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
squeezeJoin (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ Int -> Pattern a
zoompat (Int -> Pattern a) -> Pattern Int -> Pattern (Pattern a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Int
ipat
where zoompat :: Int -> Pattern a
zoompat Int
i = (Rational, Rational) -> Pattern a -> Pattern a
forall a. (Rational, Rational) -> Pattern a -> Pattern a
zoom (Rational
i'Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/(Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n), (Rational
i'Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+Rational
1)Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/(Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)) Pattern a
pat
where i' :: Rational
i' = Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Rational) -> Int -> Rational
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
n
squeeze :: Pattern Int -> [Pattern a] -> Pattern a
squeeze :: forall a. Pattern Int -> [Pattern a] -> Pattern a
squeeze Pattern Int
_ [] = Pattern a
forall a. Pattern a
silence
squeeze Pattern Int
ipat [Pattern a]
pats = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
squeezeJoin (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ ([Pattern a]
pats [Pattern a] -> Int -> Pattern a
forall a. [a] -> Int -> a
!!!) (Int -> Pattern a) -> Pattern Int -> Pattern (Pattern 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 = (EventF Arc (Pattern ValueMap) -> [Event ValueMap])
-> [EventF Arc (Pattern ValueMap)] -> [Event ValueMap]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (State -> EventF Arc (Pattern ValueMap) -> [Event ValueMap]
f State
st) (Pattern (Pattern ValueMap)
-> State -> [EventF Arc (Pattern ValueMap)]
forall a. Pattern a -> State -> [Event a]
query (Pattern (Pattern ValueMap) -> Pattern (Pattern ValueMap)
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) =
(Event ValueMap -> Maybe (Event ValueMap))
-> [Event ValueMap] -> [Event ValueMap]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Context -> Arc -> Arc -> Event ValueMap -> Maybe (Event ValueMap)
forall {b}.
Context -> Arc -> Arc -> EventF Arc b -> Maybe (EventF Arc b)
munge Context
c Arc
w Arc
p) ([Event ValueMap] -> [Event ValueMap])
-> [Event ValueMap] -> [Event ValueMap]
forall a b. (a -> b) -> a -> b
$ Pattern ValueMap -> State -> [Event ValueMap]
forall a. Pattern a -> State -> [Event a]
query (Arc -> Pattern ValueMap -> Pattern ValueMap
forall a. Arc -> Pattern a -> Pattern a
compressArc (Arc -> Arc
cycleArc Arc
w) (Pattern ValueMap
v Pattern ValueMap -> Pattern ValueMap -> Pattern ValueMap
forall a. Num a => Pattern a -> Pattern a -> Pattern a
|* Pattern Double -> Pattern ValueMap
P.speed (Double -> Pattern Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Pattern Double) -> Double -> Pattern Double
forall a b. (a -> b) -> a -> b
$ Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Rational -> Double) -> Rational -> Double
forall a b. (a -> b) -> a -> b
$ Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/(Arc -> Rational
forall a. ArcF a -> a
stop Arc
w Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Arc -> Rational
forall a. ArcF a -> a
start Arc
w)))) State
st {arc :: Arc
arc = Arc
p}
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
EventF Arc b -> Maybe (EventF Arc b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Context -> Maybe Arc -> Arc -> b -> EventF Arc b
forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event ([Context] -> Context
combineContexts [Context
ci,Context
co]) (Arc -> Maybe Arc
forall a. a -> Maybe a
Just Arc
w') Arc
p' b
v)
munge Context
_ Arc
_ Arc
_ EventF Arc b
_ = Maybe (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 (Pattern (Pattern ValueMap) -> Pattern ValueMap)
-> Pattern (Pattern ValueMap) -> Pattern ValueMap
forall a b. (a -> b) -> a -> b
$ Int -> Pattern ValueMap
zoompat (Int -> Pattern ValueMap)
-> Pattern Int -> Pattern (Pattern ValueMap)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Int
ipat) Pattern ValueMap -> Pattern ValueMap -> Pattern ValueMap
forall a. Fractional a => Pattern a -> Pattern a -> Pattern a
|/ Pattern Double -> Pattern ValueMap
P.speed (Double -> Pattern Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Pattern Double) -> Double -> Pattern Double
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
where zoompat :: Int -> Pattern ValueMap
zoompat Int
i = (Rational, Rational) -> Pattern ValueMap -> Pattern ValueMap
forall a. (Rational, Rational) -> Pattern a -> Pattern a
zoom (Rational
i'Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/(Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n), (Rational
i'Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+Rational
1)Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/(Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)) (Pattern ValueMap
pat)
where i' :: Rational
i' = Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Rational) -> Int -> Rational
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
n
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 = Pattern (Pattern ValueMap) -> Pattern ValueMap
forall a. Pattern (Pattern a) -> Pattern a
innerJoin (Pattern (Pattern ValueMap) -> Pattern ValueMap)
-> Pattern (Pattern ValueMap) -> Pattern ValueMap
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) (Int -> Pattern ValueMap)
-> Pattern Int -> Pattern (Pattern ValueMap)
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 = (Int -> Bool) -> [Int] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (b -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit b
num) ([Int] -> [Bool]) -> [Int] -> [Bool]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int]
forall a. [a] -> [a]
reverse [Int
0 .. Int
nInt -> Int -> Int
forall 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 = [Bool] -> Pattern Bool
forall a. [a] -> Pattern a
listToPat ([Bool] -> Pattern Bool) -> [Bool] -> Pattern Bool
forall a b. (a -> b) -> a -> b
$ Int -> b -> [Bool]
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 = Pattern (Pattern Bool) -> Pattern Bool
forall a. Pattern (Pattern a) -> Pattern a
squeezeJoin (Pattern (Pattern Bool) -> Pattern Bool)
-> Pattern (Pattern Bool) -> Pattern Bool
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Pattern Bool
forall b. Bits b => Int -> b -> Pattern Bool
_binary Int
n (Int -> Pattern Bool) -> Pattern Int -> Pattern (Pattern Bool)
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 = (Int -> Pattern Int -> Pattern Bool)
-> Pattern Int -> Pattern Int -> Pattern Bool
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 = Pattern (Pattern Bool) -> Pattern Bool
forall a. Pattern (Pattern a) -> Pattern a
squeezeJoin (Pattern (Pattern Bool) -> Pattern Bool)
-> Pattern (Pattern Bool) -> Pattern Bool
forall a b. (a -> b) -> a -> b
$ ([Bool] -> Pattern Bool
forall a. [a] -> Pattern a
listToPat ([Bool] -> Pattern Bool)
-> ([Char] -> [Bool]) -> [Char] -> Pattern Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> [Bool]) -> [Char] -> [Bool]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> Int -> [Bool]
forall b. Bits b => Int -> b -> [Bool]
__binary Int
8 (Int -> [Bool]) -> (Char -> Int) -> Char -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord)) ([Char] -> Pattern Bool)
-> Pattern [Char] -> Pattern (Pattern Bool)
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 Pattern ValueMap -> Pattern ValueMap -> Pattern ValueMap
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 Pattern Double -> Pattern Double -> Pattern Double
forall a. Num a => a -> a -> a
+ Pattern Double
w
necklace :: Rational -> [Int] -> Pattern Bool
necklace :: Rational -> [Int] -> Pattern Bool
necklace Rational
perCycle [Int]
xs = Rational -> Pattern Bool -> Pattern Bool
forall a. Rational -> Pattern a -> Pattern a
_slow ((Int -> Rational
forall a. Real a => a -> Rational
toRational (Int -> Rational) -> Int -> Rational
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
xs) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
perCycle) (Pattern Bool -> Pattern Bool) -> Pattern Bool -> Pattern Bool
forall a b. (a -> b) -> a -> b
$ [Bool] -> Pattern Bool
forall a. [a] -> Pattern a
listToPat ([Bool] -> Pattern Bool) -> [Bool] -> Pattern Bool
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
TrueBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:(Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Bool
False)) [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ [Int] -> [Bool]
list [Int]
xs'