{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, OverloadedStrings #-}
module Sound.Tidal.UI where
import Prelude hiding ((<*), (*>))
import Data.Char (digitToInt, isDigit, ord)
import Data.Bits (testBit, Bits)
import System.Random.MWC
import Control.Monad.ST
import Control.Monad.Primitive (PrimState, PrimMonad)
import qualified Data.Vector as V
import Data.Word (Word32)
import Data.Ratio ((%),numerator,denominator)
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
timeToSeed :: (PrimMonad m, Real a) => a -> m (Gen (PrimState m))
timeToSeed :: a -> m (Gen (PrimState m))
timeToSeed x :: a
x = do
let x' :: Rational
x' = a -> Rational
forall a. Real a => a -> Rational
toRational (a
xa -> a -> a
forall a. Num a => a -> a -> a
*a
x) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ 1000000
let n' :: Word32
n' = Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word32) -> Integer -> Word32
forall a b. (a -> b) -> a -> b
$ Rational -> Integer
forall a. Ratio a -> a
numerator Rational
x'
let d' :: Word32
d' = Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word32) -> Integer -> Word32
forall a b. (a -> b) -> a -> b
$ Rational -> Integer
forall a. Ratio a -> a
denominator Rational
x'
Vector Word32 -> m (Gen (PrimState m))
forall (m :: * -> *) (v :: * -> *).
(PrimMonad m, Vector v Word32) =>
v Word32 -> m (Gen (PrimState m))
initialize ([Word32] -> Vector Word32
forall a. [a] -> Vector a
V.fromList [Word32
n',Word32
d'] :: V.Vector Word32)
timeToRand :: RealFrac a => a -> Double
timeToRand :: a -> Double
timeToRand x :: a
x = (forall s. ST s Double) -> Double
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Double) -> Double)
-> (forall s. ST s Double) -> Double
forall a b. (a -> b) -> a -> b
$ do Gen s
seed <- a -> ST s (Gen (PrimState (ST s)))
forall (m :: * -> *) a.
(PrimMonad m, Real a) =>
a -> m (Gen (PrimState m))
timeToSeed a
x
Gen (PrimState (ST s)) -> ST s Double
forall a (m :: * -> *).
(Variate a, PrimMonad m) =>
Gen (PrimState m) -> m a
uniform Gen s
Gen (PrimState (ST s))
seed
timeToRands :: RealFrac a => a -> Int -> [Double]
timeToRands :: a -> Int -> [Double]
timeToRands x :: a
x n :: Int
n = Vector Double -> [Double]
forall a. Vector a -> [a]
V.toList (Vector Double -> [Double]) -> Vector Double -> [Double]
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (Vector Double)) -> Vector Double
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Vector Double)) -> Vector Double)
-> (forall s. ST s (Vector Double)) -> Vector Double
forall a b. (a -> b) -> a -> b
$ do Gen s
seed <- a -> ST s (Gen (PrimState (ST s)))
forall (m :: * -> *) a.
(PrimMonad m, Real a) =>
a -> m (Gen (PrimState m))
timeToSeed a
x
Gen (PrimState (ST s)) -> Int -> ST s (Vector Double)
forall (m :: * -> *) a (v :: * -> *).
(PrimMonad m, Variate a, Vector v a) =>
Gen (PrimState m) -> Int -> m (v a)
uniformVector Gen s
Gen (PrimState (ST s))
seed Int
n
rand :: Fractional a => Pattern a
rand :: Pattern a
rand = Query a -> Pattern a
forall a. Query a -> Pattern a
Pattern (\(State a :: Arc
a@(Arc s :: Rational
s e :: Rational
e) _) -> [Context -> Maybe Arc -> Arc -> a -> EventF Arc 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. RealFrac a => a -> Double
timeToRand (Rational -> Double) -> Rational -> Double
forall a b. (a -> b) -> a -> b
$ (Rational
e Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
s)Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/2)])
irand :: Num a => Int -> Pattern a
irand :: Int -> Pattern a
irand i :: 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 :: Pattern Double -> Pattern Double
perlinWith :: Pattern Double -> Pattern Double
perlinWith p :: Pattern Double
p = 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. RealFrac a => a -> Double
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. RealFrac a => a -> Double
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
+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 x :: a
x a :: a
a b :: 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 x :: a
x = 6.0 a -> a -> a
forall a. Num a => a -> a -> a
* a
xa -> a -> a
forall a. Floating a => a -> a -> a
**5 a -> a -> a
forall a. Num 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
**4 a -> a -> a
forall a. Num 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
**3
perlin :: Pattern Double
perlin :: Pattern Double
perlin = Pattern Double -> Pattern Double
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 x :: Pattern Double
x y :: Pattern Double
y = (Pattern Double -> Pattern Double -> Pattern Double
forall a. Fractional a => a -> a -> a
/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
+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
+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 -> Double
randAngle a :: a
a b :: a
b = 2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Num a => a -> a -> a
* a -> Double
forall a. RealFrac a => a -> Double
timeToRand (a
a a -> a -> a
forall a. Num a => a -> a -> a
+ 0.0001 a -> a -> a
forall a. Num a => a -> a -> a
* a
b)
pcos :: f a -> f a -> f Double
pcos x' :: f a
x' y' :: f a
y' = f Double -> f Double
forall a. Floating a => a -> a
cos (f Double -> f Double) -> f Double -> f Double
forall a b. (a -> b) -> a -> b
$ a -> a -> Double
forall a. RealFrac a => a -> a -> Double
randAngle (a -> a -> Double) -> f a -> f (a -> Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
x' f (a -> Double) -> f a -> f Double
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
y'
psin :: f a -> f a -> f Double
psin x' :: f a
x' y' :: f a
y' = f Double -> f Double
forall a. Floating a => a -> a
sin (f Double -> f Double) -> f Double -> f Double
forall a b. (a -> b) -> a -> b
$ a -> a -> Double
forall a. RealFrac a => a -> a -> Double
randAngle (a -> a -> Double) -> f a -> f (a -> Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
x' f (a -> Double) -> f a -> f Double
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 :: * -> *) a.
(Floating (f Double), Applicative f, RealFrac a) =>
f a -> f a -> f Double
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 :: * -> *) a.
(Floating (f Double), Applicative f, RealFrac a) =>
f a -> f a -> f Double
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 :: * -> *) a.
(Floating (f Double), Applicative f, RealFrac a) =>
f a -> f a -> f Double
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
- 1) Pattern Double -> Pattern Double -> Pattern Double
forall a. Num a => a -> a -> a
+ Pattern Double -> Pattern Double -> Pattern Double
forall (f :: * -> *) a.
(Floating (f Double), Applicative f, RealFrac a) =>
f a -> f a -> f Double
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 :: * -> *) a.
(Floating (f Double), Applicative f, RealFrac a) =>
f a -> f a -> f Double
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 :: * -> *) a.
(Floating (f Double), Applicative f, RealFrac a) =>
f a -> f a -> f Double
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
- 1)
dotd :: Pattern Double
dotd = Pattern Double -> Pattern Double -> Pattern Double
forall (f :: * -> *) a.
(Floating (f Double), Applicative f, RealFrac a) =>
f a -> f a -> f Double
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
- 1) Pattern Double -> Pattern Double -> Pattern Double
forall a. Num a => a -> a -> a
+ Pattern Double -> Pattern Double -> Pattern Double
forall (f :: * -> *) a.
(Floating (f Double), Applicative f, RealFrac a) =>
f a -> f a -> f Double
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
- 1)
interp2 :: a -> a -> a -> a -> a -> a -> a
interp2 x' :: a
x' y' :: a
y' a :: a
a b :: a
b c :: a
c d :: a
d = (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
* (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
* (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
+ (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 x' :: a
x' = 6.0 a -> a -> a
forall a. Num a => a -> a -> a
* a
x'a -> a -> a
forall a. Floating a => a -> a -> a
**5 a -> a -> a
forall a. Num 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
**4 a -> a -> a
forall a. Num 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
**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 :: [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 :: Pattern Double -> [a] -> Pattern a
chooseBy _ [] = Pattern a
forall a. Pattern a
silence
chooseBy f :: Pattern Double
f xs :: [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 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 :: [(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 :: Pattern Double -> [(a, Double)] -> Pattern a
wchooseBy pat :: Pattern Double
pat pairs :: [(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 r :: 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 :: 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 :: 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 :: Pattern Double -> Double -> Pattern a -> Pattern a
_degradeByUsing prand :: Pattern Double
prand x :: Double
x p :: 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 :: 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 :: Double -> Pattern a -> Pattern a
_unDegradeBy x :: Double
x p :: 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 :: Int -> Pattern Double -> Pattern a -> Pattern a
degradeOverBy i :: Int
i tx :: Pattern Double
tx p :: 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
$ (\x :: 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 :: Pattern Double
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
sometimesBy x :: Pattern Double
x f :: Pattern a -> Pattern a
f p :: Pattern a
p = 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
p) (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
p)
sometimes :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
sometimes :: (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 0.5
often :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
often :: (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 0.75
rarely :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
rarely :: (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 0.25
almostNever :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
almostNever :: (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 0.1
almostAlways :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
almostAlways :: (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 0.9
never :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
never :: (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 :: (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 :: Pattern Double
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
someCyclesBy pd :: Pattern Double
pd f :: Pattern a -> Pattern a
f p :: Pattern a
p = do {Double
d <- Pattern Double
pd; 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
p}
_someCyclesBy :: Double -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_someCyclesBy :: Double -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_someCyclesBy x :: 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 c :: a
c = Double -> Double
forall a. RealFrac a => a -> Double
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 :: 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 :: (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 0.5
somecycles :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
somecycles :: (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 :: Pattern a -> Pattern a
degrade = Double -> Pattern a -> Pattern a
forall a. Double -> Pattern a -> Pattern a
_degradeBy 0.5
brak :: Pattern a -> Pattern a
brak :: 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
== 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` 2)) (((1Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%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
. (\x :: 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 :: 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 :: Int -> Pattern a -> Pattern a
_iter n :: Int
n p :: 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 (\i :: 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) [0 .. (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)]
iter' :: Pattern Int -> Pattern c -> Pattern c
iter' :: 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' :: Int -> Pattern a -> Pattern a
_iter' n :: Int
n p :: 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 (\i :: 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) [0 .. (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)]
palindrome :: Pattern a -> Pattern a
palindrome :: Pattern a -> Pattern a
palindrome p :: 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 :: [(Rational, Rational, Pattern a)] -> Pattern a
seqP ps :: [(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 (\(s :: Rational
s, e :: Rational
e, p :: 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 :: Rational -> Pattern a -> Pattern a
fadeOut dur :: Rational
dur p :: Pattern a
p = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
innerJoin (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ (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 :: Rational -> Rational -> Pattern a -> Pattern a
fadeOutFrom from :: Rational
from dur :: Rational
dur p :: Pattern a
p = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
innerJoin (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ (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 :: Rational -> Pattern a -> Pattern a
fadeIn dur :: Rational
dur p :: Pattern a
p = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
innerJoin (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ (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 :: Rational -> Rational -> Pattern a -> Pattern a
fadeInFrom from :: Rational
from dur :: Rational
dur p :: Pattern a
p = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
innerJoin (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ (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 :: (a -> t -> Pattern b) -> [a] -> t -> Pattern b
spread f :: a -> t -> Pattern b
f xs :: [a]
xs p :: 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 :: (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 :: (a -> t -> Pattern b) -> [a] -> t -> Pattern b
fastspread f :: a -> t -> Pattern b
f xs :: [a]
xs p :: 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' :: (a -> b -> m c) -> m a -> b -> m c
spread' f :: a -> b -> m c
f vpat :: m a
vpat pat :: 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
>>= \v :: a
v -> a -> b -> m c
f a
v b
pat
spreadChoose :: (t -> t1 -> Pattern b) -> [t] -> t1 -> Pattern b
spreadChoose :: (t -> t1 -> Pattern b) -> [t] -> t1 -> Pattern b
spreadChoose f :: t -> t1 -> Pattern b
f vs :: [t]
vs p :: t1
p = do t
v <- Rational -> Pattern t -> Pattern t
forall a. Rational -> Pattern a -> Pattern a
_segment 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 :: (t -> t1 -> Pattern b) -> [t] -> t1 -> 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 :: (Int -> Bool)
-> (Pattern a -> Pattern a)
-> (Pattern a -> Pattern a)
-> Pattern a
-> Pattern a
ifp test :: Int -> Bool
test f1 :: Pattern a -> Pattern a
f1 f2 :: Pattern a -> Pattern a
f2 p :: 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 :: Query a
query = Query a
q}
where q :: Query a
q a :: 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 -> Query a
forall a. Pattern a -> Query a
query (Pattern a -> Pattern a
f1 Pattern a
p) State
a
| Bool
otherwise = Pattern a -> Query a
forall a. Pattern a -> Query a
query (Pattern a -> Pattern a
f2 Pattern a
p) State
a
wedge :: Time -> Pattern a -> Pattern a -> Pattern a
wedge :: Rational -> Pattern a -> Pattern a -> Pattern a
wedge 0 _ p' :: Pattern a
p' = Pattern a
p'
wedge 1 p :: Pattern a
p _ = Pattern a
p
wedge t :: Rational
t p :: Pattern a
p 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 (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 (1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/(1Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
t)) Pattern a
p')
whenmod :: Int -> Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
whenmod :: Int -> Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
whenmod a :: Int
a b :: Int
b = (Int -> Bool) -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a.
(Int -> Bool) -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
Sound.Tidal.Core.when (\t :: Int
t -> (Int
t Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
a) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
b )
superimpose :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
superimpose :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a
superimpose f :: Pattern a -> Pattern a
f p :: 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 :: 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 :: Rational -> Pattern a -> Pattern a
_trunc t :: Rational
t = (Rational, Rational) -> Pattern a -> Pattern a
forall a. (Rational, Rational) -> Pattern a -> Pattern a
compress (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 0 Rational
t)
linger :: Pattern Time -> Pattern a -> Pattern a
linger :: 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 :: Rational -> Pattern a -> Pattern a
_linger n :: Rational
n p :: Pattern a
p = Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
_fast (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 0 Rational
n) Pattern a
p
within :: (Time, Time) -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
within :: (Rational, Rational)
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
within (s :: Rational
s, e :: Rational
e) f :: Pattern a -> Pattern a
f p :: 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 (\t :: 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 (\t :: 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 :: Arc -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
withinArc (Arc s :: Rational
s e :: 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' :: (Rational, Rational)
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
within' a :: (Rational, Rational)
a@(s :: Rational
s, e :: Rational
e) f :: Pattern a -> Pattern a
f p :: 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 (\t :: 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 (\t :: 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 :: (Rational, Rational) -> Pattern a -> Pattern a
revArc a :: (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 :: 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 :: Int -> Int -> Pattern a -> Pattern a
_euclid n :: Int
n k :: Int
k a :: 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 :: Pattern Int -> Pattern Int -> Pattern a -> Pattern a -> Pattern a
euclidFull n :: Pattern Int
n k :: Pattern Int
k pa :: Pattern a
pa pb :: 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 n :: Int
n k :: 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' :: Int -> Int -> Pattern a -> Pattern a
_euclid' n :: Int
n k :: Int
k p :: 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 (\x :: 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 :: 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 :: 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 :: Int -> Int -> Int -> Pattern a -> Pattern a
_euclidOff _ 0 _ _ = Pattern a
forall a. Pattern a
silence
_euclidOff n :: Int
n k :: Int
k s :: Int
s p :: 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 _ 0 _ _ = Pattern Bool
forall a. Pattern a
silence
_euclidOffBool n :: Int
n k :: Int
k s :: Int
s p :: 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`) ((\a :: Bool
a b :: 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 :: [Pattern Int] -> Pattern a -> Pattern a
distrib ps :: [Pattern Int]
ps p :: 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 :: [Int] -> Pattern a -> Pattern a
_distrib xs :: [Int]
xs p :: 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' [] _ = []
distrib' (_:a :: [Bool]
a) [] = Bool
False Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: [Bool] -> [Bool] -> [Bool]
distrib' [Bool]
a []
distrib' (True:a :: [Bool]
a) (x :: Bool
x:b :: [Bool]
b) = Bool
x Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: [Bool] -> [Bool] -> [Bool]
distrib' [Bool]
a [Bool]
b
distrib' (False:a :: [Bool]
a) b :: [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 a :: [Bool]
a b' :: 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 :: 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 :: Int -> Int -> Pattern a -> Pattern a
_euclidInv n :: Int
n k :: Int
k a :: 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 :: b -> Pattern b -> Pattern c -> Pattern c
index sz :: b
sz indexpat :: Pattern b
indexpat pat :: 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
*(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' tSz :: Rational
tSz s :: 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 :: 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 :: Int -> Pattern a -> Pattern a
_rot i :: Int
i pat :: 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 :: Query a
query = \st :: State
st -> State -> [Event a] -> [Event a]
forall a. Ord a => State -> [Event a] -> [Event a]
f State
st (Pattern a -> Query a
forall a. Pattern a -> Query 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 st :: State
st es :: [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 es :: [EventF a b]
es | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 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 (\e :: EventF a b
e s :: 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 (\e :: EventF a b
e s :: 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 s :: Rational
s _) = 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 :: Arc -> [Event a] -> [Event a]
constrainEvents a :: Arc
a es :: [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 :: Arc -> Event a -> Maybe (Event a)
constrainEvent a :: Arc
a e :: 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 :: 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 :: Rational -> Pattern a -> Pattern a
_segment n :: Rational
n p :: 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 :: 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 :: [Pattern a] -> Pattern a
randcat ps :: [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 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
%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 :: [(Pattern a, Double)] -> Pattern a
wrandcat ps :: [(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 1 Pattern Double
forall a. Fractional a => Pattern a
rand) [(Pattern a, Double)]
ps
fit :: Int -> [a] -> Pattern Int -> Pattern a
fit :: Int -> [a] -> Pattern Int -> Pattern a
fit perCycle :: Int
perCycle xs :: [a]
xs p :: 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 :: Query Int
query = (EventF Arc Int -> EventF Arc Int)
-> [EventF Arc Int] -> [EventF Arc Int]
forall a b. (a -> b) -> [a] -> [b]
map (\e :: EventF Arc Int
e -> (Int -> Int) -> EventF Arc Int -> EventF Arc Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ EventF Arc Int -> Int
forall a b. RealFrac a => EventF (ArcF a) b -> Int
pos EventF Arc Int
e) EventF Arc Int
e) ([EventF Arc Int] -> [EventF Arc Int]) -> Query Int -> Query Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern Int -> Query Int
forall a. Pattern a -> Query a
query Pattern Int
p})
where pos :: EventF (ArcF a) b -> Int
pos e :: 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)
permstep :: RealFrac b => Int -> [a] -> Pattern b -> Pattern a
permstep :: Int -> [a] -> Pattern b -> Pattern a
permstep nSteps :: Int
nSteps things :: [a]
things p :: 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
$ (\n :: 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 (\x :: (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
- 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 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 avg :: a
avg xs :: [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 n :: a
n total :: 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 (\x :: [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 0 _ = []
perms 1 n :: a
n = [[a
n]]
perms n :: a
n total :: a
total = (a -> [[a]]) -> [a] -> [[a]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\x :: 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
-1) (a
totala -> a -> a
forall a. Num a => a -> a -> a
-a
x)) [1 .. (a
totala -> a -> a
forall a. Num a => a -> a -> a
-(a
na -> a -> a
forall a. Num a => a -> a -> a
-1))]
struct :: Pattern Bool -> Pattern a -> Pattern a
struct :: Pattern Bool -> Pattern a -> Pattern a
struct ps :: Pattern Bool
ps pv :: 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
$ (\a :: Bool
a b :: 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 String -> Pattern b -> Pattern b
substruct :: Pattern String -> Pattern b -> Pattern b
substruct s :: Pattern String
s p :: Pattern b
p = Pattern b
p {query :: Query b
query = Query b
f}
where f :: Query b
f st :: State
st =
(EventF Arc String -> [Event b])
-> [EventF Arc String] -> [Event b]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((\a' :: 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])
-> (EventF Arc String -> Arc) -> EventF Arc String -> [Event b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Arc -> Arc
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Arc -> Arc)
-> (EventF Arc String -> Maybe Arc) -> EventF Arc String -> Arc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventF Arc String -> Maybe Arc
forall a b. EventF a b -> Maybe a
whole) ([EventF Arc String] -> [Event b])
-> [EventF Arc String] -> [Event b]
forall a b. (a -> b) -> a -> b
$ (EventF Arc String -> Bool)
-> [EventF Arc String] -> [EventF Arc String]
forall a. (a -> Bool) -> [a] -> [a]
filter EventF Arc String -> Bool
forall a. Event a -> Bool
isDigital ([EventF Arc String] -> [EventF Arc String])
-> [EventF Arc String] -> [EventF Arc String]
forall a b. (a -> b) -> a -> b
$ (Pattern String -> Query String
forall a. Pattern a -> Query a
query Pattern String
s State
st)
randArcs :: Int -> Pattern [Arc]
randArcs :: Int -> Pattern [Arc]
randArcs n :: 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 (\x :: 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 [1 :: Int,2,3]) [0 .. (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-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 xs :: [a]
xs = a -> a -> ArcF a
forall a. a -> a -> ArcF a
Arc 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' [_] = []
pairUp' [a :: a
a, _] = [a -> a -> ArcF a
forall a. a -> a -> ArcF a
Arc a
a 1]
pairUp' (a :: a
a:b :: a
b:xs :: [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 n :: 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. Query a -> Pattern a
Pattern {query :: Query Int
query = Query Int
f}
where f :: Query Int
f st :: State
st = ((Arc, Maybe Arc, Int) -> EventF Arc Int)
-> [(Arc, Maybe Arc, Int)] -> [EventF Arc Int]
forall a b. (a -> b) -> [a] -> [b]
map (\(a :: Arc
a,b :: Maybe Arc
b,c :: Int
c) -> Context -> Maybe Arc -> Arc -> Int -> EventF Arc 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)] -> [EventF Arc Int])
-> [(Arc, Maybe Arc, Int)] -> [EventF Arc 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 (\(_,x :: Maybe Arc
x,_) -> 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 (\(i :: Int
i, Arc s' :: Rational
s' e' :: 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 s :: Rational
s e :: Rational
e) = State -> Arc
arc State
st
substruct' :: Pattern Int -> Pattern a -> Pattern a
substruct' :: Pattern Int -> Pattern a -> Pattern a
substruct' s :: Pattern Int
s p :: Pattern a
p = Pattern a
p {query :: Query a
query = \st :: State
st -> (EventF Arc Int -> [EventF Arc a])
-> [EventF Arc Int] -> [EventF Arc a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (State -> EventF Arc Int -> [EventF Arc a]
forall a. Real a => State -> EventF Arc a -> [EventF Arc a]
f State
st) (Pattern Int -> Query Int
forall a. Pattern a -> Query a
query Pattern Int
s State
st)}
where f :: State -> EventF Arc a -> [EventF Arc a]
f st :: State
st (Event c :: Context
c (Just a' :: Arc
a') _ i :: a
i) = (EventF Arc a -> EventF Arc a) -> [EventF Arc a] -> [EventF Arc a]
forall a b. (a -> b) -> [a] -> [b]
map (\e :: EventF Arc a
e -> EventF Arc a
e {context :: Context
context = [Context] -> Context
combineContexts [Context
c, EventF Arc a -> Context
forall a b. EventF a b -> Context
context EventF Arc a
e]}) ([EventF Arc a] -> [EventF Arc a])
-> [EventF Arc a] -> [EventF Arc a]
forall a b. (a -> b) -> a -> b
$ Pattern a -> Arc -> [EventF Arc 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
$ 1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Int -> Rational
forall a. Real a => a -> Rational
toRational([EventF Arc Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Pattern Int -> Arc -> [EventF Arc 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 _ _ = []
stripe :: Pattern Int -> Pattern a -> Pattern a
stripe :: Pattern Int -> Pattern a -> Pattern a
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 :: Int -> Pattern a -> Pattern a
_stripe = Pattern Int -> Pattern a -> Pattern a
forall a. Pattern Int -> Pattern a -> Pattern a
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 :: Pattern Int -> Pattern a -> Pattern a
slowstripe n :: 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 a. Pattern Int -> Pattern a -> Pattern a
stripe Pattern Int
n
parseLMRule :: String -> [(String,String)]
parseLMRule :: String -> [(String, String)]
parseLMRule s :: String
s = (String -> (String, String)) -> [String] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> String -> (String, String)
forall a. Eq a => a -> [a] -> ([a], [a])
splitOn ':') [String]
commaSplit
where splitOn :: a -> [a] -> ([a], [a])
splitOn sep :: a
sep str :: [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 :: [String]
commaSplit = (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack ([Text] -> [String]) -> [Text] -> [String]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
T.splitOn (String -> Text
T.pack ",") (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
parseLMRule' :: String -> [(Char, String)]
parseLMRule' :: String -> [(Char, String)]
parseLMRule' str :: String
str = ((String, String) -> (Char, String))
-> [(String, String)] -> [(Char, String)]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> (Char, String)
forall a b. ([a], b) -> (a, b)
fixer ([(String, String)] -> [(Char, String)])
-> [(String, String)] -> [(Char, String)]
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)]
parseLMRule String
str
where fixer :: ([a], b) -> (a, b)
fixer (c :: [a]
c,r :: b
r) = ([a] -> a
forall a. [a] -> a
head [a]
c, b
r)
lindenmayer :: Int -> String -> String -> String
lindenmayer :: Int -> String -> String -> String
lindenmayer _ _ [] = []
lindenmayer 1 r :: String
r (c :: Char
c:cs :: String
cs) = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe [Char
c] (Char -> [(Char, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Char
c ([(Char, String)] -> Maybe String)
-> [(Char, String)] -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> [(Char, String)]
parseLMRule' String
r)
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String -> String
lindenmayer 1 String
r String
cs
lindenmayer n :: Int
n r :: String
r s :: String
s = (String -> String) -> String -> [String]
forall a. (a -> a) -> a -> [a]
iterate (Int -> String -> String -> String
lindenmayer 1 String
r) String
s [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int
n
lindenmayerI :: Num b => Int -> String -> String -> [b]
lindenmayerI :: Int -> String -> String -> [b]
lindenmayerI n :: Int
n r :: String
r s :: String
s = (Char -> b) -> String -> [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) (String -> [b]) -> String -> [b]
forall a b. (a -> b) -> a -> b
$ Int -> String -> String -> String
lindenmayer Int
n String
r String
s
runMarkov :: Int -> [[Double]] -> Int -> Time -> [Int]
runMarkov :: Int -> [[Double]] -> Int -> Rational -> [Int]
runMarkov n :: Int
n tp :: [[Double]]
tp xi :: Int
xi seed :: 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]
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
-1) where
markovStep :: [[Double]] -> [Int] -> [Int]
markovStep tp' :: [[Double]]
tp' xs :: [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
$ (Double -> Bool) -> [Double] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (Double
r Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<=) ([Double] -> Maybe Int) -> [Double] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ (Double -> Double -> Double) -> [Double] -> [Double]
forall a. (a -> a -> a) -> [a] -> [a]
scanl1 Double -> Double -> Double
forall a. Num a => a -> a -> a
(+) ([[Double]]
tp'[[Double]] -> Int -> [Double]
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 :: Double
r = Rational -> Double
forall a. RealFrac a => a -> Double
timeToRand (Rational -> Double) -> Rational -> Double
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 n :: Int
n xi :: Int
xi tp :: [[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
$ Query Int -> Pattern Int
forall a. Query a -> Pattern a
Pattern (\(State a :: Arc
a@(Arc s :: Rational
s _) _) ->
Pattern Int -> Arc -> [EventF Arc 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 :: Pattern Bool -> Pattern a -> Pattern a
mask b :: Pattern Bool
b p :: 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 0 1
enclosingArc as :: [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 :: Pattern a -> Pattern a
stretch p :: 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 :: Query a
query = Query a
q}
where q :: Query a
q st :: State
st = Pattern a -> Query a
forall a. Pattern a -> Query 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 -> Query a
forall a. Pattern a -> Query 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' :: Pattern Rational
-> Int -> Pattern Int -> Pattern Int -> Pattern a -> Pattern a
fit' cyc :: Pattern Rational
cyc n :: Int
n from :: Pattern Int
from to :: Pattern Int
to p :: 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 <- [0..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-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 :: Int -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b
chunk n :: Int
n f :: Pattern b -> Pattern b
f p :: 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
+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 <- [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
- 1]]
runWith :: Int -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b
runWith :: 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' :: a -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b
chunk' n :: a
n f :: Pattern b -> Pattern b
f p :: 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
+)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
runWith' :: Integral a => a -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b
runWith' :: a -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b
runWith' = a -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b
forall a b.
Integral a =>
a -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b
chunk'
inside :: Pattern Time -> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
inside :: Pattern Rational
-> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
inside n :: Pattern Rational
n f :: Pattern a1 -> Pattern a
f p :: Pattern a1
p = Pattern Rational -> Pattern a -> Pattern a
forall a. Pattern Rational -> Pattern a -> Pattern a
density Pattern Rational
n (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ Pattern a1 -> Pattern a
f (Pattern Rational -> Pattern a1 -> Pattern a1
forall a. Pattern Rational -> Pattern a -> Pattern a
slow Pattern Rational
n Pattern a1
p)
outside :: Pattern Time -> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
outside :: Pattern Rational
-> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
outside n :: Pattern Rational
n = Pattern Rational
-> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
forall a1 a.
Pattern Rational
-> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a
inside (1Pattern Rational -> Pattern Rational -> Pattern Rational
forall a. Fractional a => a -> a -> a
/Pattern Rational
n)
loopFirst :: Pattern a -> Pattern a
loopFirst :: Pattern a -> Pattern a
loopFirst p :: 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 :: Query a
query = Query a
f}
where f :: Query a
f st :: State
st = (EventF Arc a -> EventF Arc a) -> [EventF Arc a] -> [EventF Arc a]
forall a b. (a -> b) -> [a] -> [b]
map
(\(Event c :: Context
c w :: Maybe Arc
w p' :: Arc
p' v :: a
v) ->
Context -> Maybe Arc -> Arc -> a -> EventF Arc 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) ([EventF Arc a] -> [EventF Arc a])
-> [EventF Arc a] -> [EventF Arc a]
forall a b. (a -> b) -> a -> b
$
Pattern a -> Query a
forall a. Pattern a -> Query 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 :: Pattern Rational -> Pattern a -> Pattern a
timeLoop n :: 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 :: [(Rational, Rational, Pattern a)] -> Pattern a
seqPLoop ps :: [(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 (\(x :: Rational
x,_,_) -> 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 (\(_,x :: Rational
x,_) -> Rational
x) [(Rational, Rational, Pattern a)]
ps
toScale' :: Num a => Int -> [a] -> Pattern Int -> Pattern a
toScale' :: Int -> [a] -> Pattern Int -> Pattern a
toScale' _ [] = Pattern a -> Pattern Int -> Pattern a
forall a b. a -> b -> a
const Pattern a
forall a. Pattern a
silence
toScale' o :: Int
o s :: [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 x :: 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 x :: 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 :: [a] -> Pattern Int -> Pattern a
toScale = Int -> [a] -> Pattern Int -> Pattern a
forall a. Num a => Int -> [a] -> Pattern Int -> Pattern a
toScale' 12
swingBy :: Pattern Time -> Pattern Time -> Pattern a -> Pattern a
swingBy :: Pattern Rational -> Pattern Rational -> Pattern a -> Pattern a
swingBy x :: Pattern Rational
x n :: 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 0.5 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 :: 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
$ 1Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%3)
cycleChoose :: [a] -> Pattern a
cycleChoose :: [a] -> Pattern a
cycleChoose = Pattern Rational -> Pattern a -> Pattern a
forall a. Pattern Rational -> Pattern a -> Pattern a
segment 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 :: Pattern Int -> Int -> Pattern a -> Pattern a
_rearrangeWith ipat :: Pattern Int
ipat n :: Int
n pat :: 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
$ (\i :: 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 (\i :: 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
+1) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
nT) Pattern a
pat) [0 .. (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-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 :: Pattern Int -> Pattern a -> Pattern a
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 :: Int -> Pattern a -> Pattern a
_shuffle n :: 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 :: Pattern Int -> Pattern a -> Pattern a
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 :: Int -> Pattern a -> Pattern a
_scramble n :: 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 0 = Pattern Int
forall a. Pattern a
silence
randrun n' :: 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
$ Query Int -> Pattern Int
forall a. Query a -> Pattern a
Pattern (\(State a :: Arc
a@(Arc s :: Rational
s _) _) -> Arc -> Rational -> [EventF Arc Int]
forall a. RealFrac a => Arc -> a -> [EventF Arc Int]
events Arc
a (Rational -> [EventF Arc Int]) -> Rational -> [EventF Arc Int]
forall a b. (a -> b) -> a -> b
$ Rational -> Rational
sam Rational
s)
where events :: Arc -> a -> [EventF Arc Int]
events a :: Arc
a seed :: a
seed = ((Arc, Int) -> Maybe (EventF Arc Int))
-> [(Arc, Int)] -> [EventF Arc Int]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Arc, Int) -> Maybe (EventF Arc Int)
forall b. (Arc, b) -> Maybe (EventF Arc b)
toEv ([(Arc, Int)] -> [EventF Arc Int])
-> [(Arc, Int)] -> [EventF Arc 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 [0 .. (Int
n'Int -> Int -> Int
forall a. Num a => a -> a -> a
-1)]
rs :: [Double]
rs = a -> Int -> [Double]
forall a. RealFrac a => a -> Int -> [Double]
timeToRands a
seed Int
n'
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)) [0, 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' .. 1]
toEv :: (Arc, b) -> Maybe (EventF Arc b)
toEv (a' :: Arc
a',v :: 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 :: Rational
-> Pattern String
-> [(String, Pattern a)]
-> [(String, Pattern a -> Pattern a)]
-> Pattern a
ur t :: Rational
t outer_p :: Pattern String
outer_p ps :: [(String, Pattern a)]
ps fs :: [(String, 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 ([String] -> (Pattern a, Arc -> Pattern a -> Pattern a)
getPat ([String] -> (Pattern a, Arc -> Pattern a -> Pattern a))
-> (String -> [String])
-> String
-> (Pattern a, Arc -> Pattern a -> Pattern a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
split (String -> (Pattern a, Arc -> Pattern a -> Pattern a))
-> Pattern String
-> Pattern (Pattern a, Arc -> Pattern a -> Pattern a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern String
outer_p)
where split :: String -> [String]
split = (Char -> Bool) -> String -> [String]
forall a. (a -> Bool) -> [a] -> [[a]]
wordsBy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==':')
getPat :: [String] -> (Pattern a, Arc -> Pattern a -> Pattern a)
getPat (s :: String
s:xs :: [String]
xs) = (String -> Pattern a
match String
s, [String] -> Arc -> Pattern a -> Pattern a
transform [String]
xs)
getPat _ = String -> (Pattern a, Arc -> Pattern a -> Pattern a)
forall a. HasCallStack => String -> a
error "can't happen?"
match :: String -> Pattern a
match s :: String
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
$ String -> [(String, Pattern a)] -> Maybe (Pattern a)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
s [(String, Pattern a)]
ps'
ps' :: [(String, Pattern a)]
ps' = ((String, Pattern a) -> (String, Pattern a))
-> [(String, Pattern a)] -> [(String, Pattern a)]
forall a b. (a -> b) -> [a] -> [b]
map ((Pattern a -> Pattern a)
-> (String, Pattern a) -> (String, 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)) [(String, Pattern a)]
ps
adjust :: (t, (t, t -> t -> t)) -> t
adjust (a :: t
a, (p :: t
p, f :: t -> t -> t
f)) = t -> t -> t
f t
a t
p
transform :: [String] -> Arc -> Pattern a -> Pattern a
transform (x :: String
x:_) a :: Arc
a = String -> Arc -> Pattern a -> Pattern a
transform' String
x Arc
a
transform _ _ = Pattern a -> Pattern a
forall a. a -> a
id
transform' :: String -> Arc -> Pattern a -> Pattern a
transform' str :: String
str (Arc s :: Rational
s e :: Rational
e) p :: 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
$ 1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/(Rational
eRational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
s)) (String -> Pattern a -> Pattern a
matchF String
str) Pattern a
p
matchF :: String -> Pattern a -> Pattern a
matchF str :: String
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
$ String
-> [(String, Pattern a -> Pattern a)]
-> Maybe (Pattern a -> Pattern a)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
str [(String, 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 c :: Context
c (Just a :: Arc
a) a' :: Arc
a' v :: 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 :: [(String, Pattern a)] -> Pattern String -> Pattern a
inhabit ps :: [(String, Pattern a)]
ps p :: Pattern String
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
$ (\s :: String
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
$ String -> [(String, Pattern a)] -> Maybe (Pattern a)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
s [(String, Pattern a)]
ps) (String -> Pattern a) -> Pattern String -> Pattern (Pattern a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern String
p
spaceOut :: [Time] -> Pattern a -> Pattern a
spaceOut :: [Rational] -> Pattern a -> Pattern a
spaceOut xs :: [Rational]
xs p :: 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 _ [] = []
markOut offset :: Rational
offset (x :: Rational
x:xs' :: [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 a :: Rational
a b :: 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 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 :: Pattern [a] -> Pattern a
flatpat p :: Pattern [a]
p = Pattern [a]
p {query :: Query a
query = (EventF Arc [a] -> [EventF Arc a])
-> [EventF Arc [a]] -> [EventF Arc a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Event c :: Context
c b :: Maybe Arc
b b' :: Arc
b' xs :: [a]
xs) -> (a -> EventF Arc a) -> [a] -> [EventF Arc a]
forall a b. (a -> b) -> [a] -> [b]
map (Context -> Maybe Arc -> Arc -> a -> EventF Arc 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]] -> [EventF Arc a])
-> (State -> [EventF Arc [a]]) -> Query a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern [a] -> State -> [EventF Arc [a]]
forall a. Pattern a -> Query a
query Pattern [a]
p}
layer :: [a -> Pattern b] -> a -> Pattern b
layer :: [a -> Pattern b] -> a -> Pattern b
layer fs :: [a -> Pattern b]
fs p :: 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 :: 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 :: 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 :: ([EventF Arc a] -> [EventF Arc b]) -> Pattern a -> Pattern b
arpWith f :: [EventF Arc a] -> [EventF Arc b]
f p :: 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 es :: [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 (\a :: EventF Arc a
a b :: 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 xs :: [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 (\(n :: Int
n, x :: EventF Arc b
x) -> Int -> Int -> EventF Arc b -> Maybe (EventF Arc b)
forall a a b.
(Integral a, Integral a) =>
a -> a -> 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 :: a -> a -> EventF Arc b -> Maybe (EventF Arc b)
shiftIt n :: a
n d :: a
d (Event c :: Context
c (Just (Arc s :: Rational
s e :: Rational
e)) a' :: Arc
a' v :: 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
* a -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
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
/ a -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
d
shiftIt _ _ _ = Maybe (EventF Arc b)
forall a. Maybe a
Nothing
arp :: Pattern String -> Pattern a -> Pattern a
arp :: Pattern String -> Pattern a -> Pattern a
arp = (String -> Pattern a -> Pattern a)
-> Pattern String -> Pattern a -> Pattern a
forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam String -> Pattern a -> Pattern a
forall a. String -> Pattern a -> Pattern a
_arp
_arp :: String -> Pattern a -> Pattern a
_arp :: String -> Pattern a -> Pattern a
_arp name :: String
name p :: 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
$ String -> [(String, [a] -> [a])] -> Maybe ([a] -> [a])
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
name [(String, [a] -> [a])]
forall a. [(String, [a] -> [a])]
arps
arps :: [(String, [a] -> [a])]
arps :: [(String, [a] -> [a])]
arps = [("up", [a] -> [a]
forall a. a -> a
id),
("down", [a] -> [a]
forall a. [a] -> [a]
reverse),
("updown", \x :: [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)),
("downup", \x :: [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),
("up&down", \x :: [a]
x -> [a]
x [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. [a] -> [a]
reverse [a]
x),
("down&up", \x :: [a]
x -> [a] -> [a]
forall a. [a] -> [a]
reverse [a]
x [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
x),
("converge", [a] -> [a]
forall a. [a] -> [a]
converge),
("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),
("disconverge", \x :: [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)),
("pinkyup", [a] -> [a]
forall a. [a] -> [a]
pinkyup),
("pinkyupdown", \x :: [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)),
("thumbup", [a] -> [a]
forall a. [a] -> [a]
thumbup),
("thumbupdown", \x :: [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 (x :: a
x:xs :: [a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
converge' [a]
xs
converge' :: [a] -> [a]
converge' [] = []
converge' xs :: [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 xs :: [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 xs :: [b]
xs = (b -> [b]) -> [b] -> [b]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\x :: 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 Int -> Pattern a -> Pattern a
ply :: Pattern Int -> Pattern a -> Pattern a
ply = (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
_ply
_ply :: Int -> Pattern a -> Pattern a
_ply :: Int -> Pattern a -> Pattern a
_ply n :: Int
n p :: 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
$ [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
stack (Int -> Pattern a -> [Pattern a]
forall a. Int -> a -> [a]
replicate Int
n Pattern a
p)
plyWith :: (Ord t, Num t) => Pattern t -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
plyWith :: Pattern t -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
plyWith np :: Pattern t
np f :: Pattern a -> Pattern a
f p :: Pattern a
p = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
innerJoin (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ (\n :: 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 :: t -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_plyWith numPat :: t
numPat f :: Pattern a -> Pattern a
f p :: 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 n :: t
n | t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= 1 = Pattern a
p
| Bool
otherwise = Pattern a -> Pattern a -> Pattern a
forall a. Pattern a -> Pattern a -> Pattern a
overlay Pattern a
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
-1)
sew :: Pattern Bool -> Pattern a -> Pattern a -> Pattern a
sew :: Pattern Bool -> Pattern a -> Pattern a -> Pattern a
sew pb :: Pattern Bool
pb a :: Pattern a
a b :: 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 :: Pattern Bool -> Pattern a -> Pattern a -> Pattern a
stitch pb :: Pattern Bool
pb a :: Pattern a
a b :: 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 :: Pattern Bool -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
while b :: Pattern Bool
b f :: Pattern a -> Pattern a
f pat :: 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 :: i -> Rational -> Pattern a -> Pattern a
stutter n :: i
n t :: Rational
t p :: 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
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) [0 .. (i
ni -> i -> i
forall a. Num a => a -> a -> a
-1)]
echo, triple, quad, double :: Time -> Pattern a -> Pattern a
echo :: Rational -> Pattern a -> Pattern a
echo = Int -> Rational -> Pattern a -> Pattern a
forall i a. Integral i => i -> Rational -> Pattern a -> Pattern a
stutter (2 :: Int)
triple :: Rational -> Pattern a -> Pattern a
triple = Int -> Rational -> Pattern a -> Pattern a
forall i a. Integral i => i -> Rational -> Pattern a -> Pattern a
stutter (3 :: Int)
quad :: Rational -> Pattern a -> Pattern a
quad = Int -> Rational -> Pattern a -> Pattern a
forall i a. Integral i => i -> Rational -> Pattern a -> Pattern a
stutter (4 :: Int)
double :: Rational -> Pattern a -> Pattern a
double = Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
echo
jux
:: (Pattern ControlMap -> Pattern ControlMap)
-> Pattern ControlMap -> Pattern ControlMap
jux :: (Pattern ControlMap -> Pattern ControlMap)
-> Pattern ControlMap -> Pattern ControlMap
jux = Pattern Double
-> (Pattern ControlMap -> Pattern ControlMap)
-> Pattern ControlMap
-> Pattern ControlMap
juxBy 1
juxcut
:: (Pattern ControlMap -> Pattern ControlMap)
-> Pattern ControlMap -> Pattern ControlMap
juxcut :: (Pattern ControlMap -> Pattern ControlMap)
-> Pattern ControlMap -> Pattern ControlMap
juxcut f :: Pattern ControlMap -> Pattern ControlMap
f p :: Pattern ControlMap
p = [Pattern ControlMap] -> Pattern ControlMap
forall a. [Pattern a] -> Pattern a
stack [Pattern ControlMap
p Pattern ControlMap -> Pattern ControlMap -> Pattern ControlMap
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> Pattern ControlMap
P.pan (Double -> Pattern Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure 0) Pattern ControlMap -> Pattern ControlMap -> Pattern ControlMap
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Int -> Pattern ControlMap
P.cut (Int -> Pattern Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (-1)),
Pattern ControlMap -> Pattern ControlMap
f (Pattern ControlMap -> Pattern ControlMap)
-> Pattern ControlMap -> Pattern ControlMap
forall a b. (a -> b) -> a -> b
$ Pattern ControlMap
p Pattern ControlMap -> Pattern ControlMap -> Pattern ControlMap
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> Pattern ControlMap
P.pan (Double -> Pattern Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure 1) Pattern ControlMap -> Pattern ControlMap -> Pattern ControlMap
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Int -> Pattern ControlMap
P.cut (Int -> Pattern Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (-2))
]
juxcut' :: [t -> Pattern ControlMap] -> t -> Pattern ControlMap
juxcut' :: [t -> Pattern ControlMap] -> t -> Pattern ControlMap
juxcut' fs :: [t -> Pattern ControlMap]
fs p :: t
p = [Pattern ControlMap] -> Pattern ControlMap
forall a. [Pattern a] -> Pattern a
stack ([Pattern ControlMap] -> Pattern ControlMap)
-> [Pattern ControlMap] -> Pattern ControlMap
forall a b. (a -> b) -> a -> b
$ (Int -> Pattern ControlMap) -> [Int] -> [Pattern ControlMap]
forall a b. (a -> b) -> [a] -> [b]
map (\n :: Int
n -> (([t -> Pattern ControlMap]
fs [t -> Pattern ControlMap] -> Int -> t -> Pattern ControlMap
forall a. [a] -> Int -> a
!! Int
n) t
p Pattern ControlMap -> Pattern ControlMap -> Pattern ControlMap
forall a. Num a => Pattern a -> Pattern a -> Pattern a
|+ Pattern Int -> Pattern ControlMap
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
$ 1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n)) Pattern ControlMap -> Pattern ControlMap -> Pattern ControlMap
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> Pattern ControlMap
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)) [0 .. Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-1]
where l :: Int
l = [t -> Pattern ControlMap] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [t -> Pattern ControlMap]
fs
jux' :: [t -> Pattern ControlMap] -> t -> Pattern ControlMap
jux' :: [t -> Pattern ControlMap] -> t -> Pattern ControlMap
jux' fs :: [t -> Pattern ControlMap]
fs p :: t
p = [Pattern ControlMap] -> Pattern ControlMap
forall a. [Pattern a] -> Pattern a
stack ([Pattern ControlMap] -> Pattern ControlMap)
-> [Pattern ControlMap] -> Pattern ControlMap
forall a b. (a -> b) -> a -> b
$ (Int -> Pattern ControlMap) -> [Int] -> [Pattern ControlMap]
forall a b. (a -> b) -> [a] -> [b]
map (\n :: Int
n -> ([t -> Pattern ControlMap]
fs [t -> Pattern ControlMap] -> Int -> t -> Pattern ControlMap
forall a. [a] -> Int -> a
!! Int
n) t
p Pattern ControlMap -> Pattern ControlMap -> Pattern ControlMap
forall a. Num a => Pattern a -> Pattern a -> Pattern a
|+ Pattern Double -> Pattern ControlMap
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)) [0 .. Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-1]
where l :: Int
l = [t -> Pattern ControlMap] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [t -> Pattern ControlMap]
fs
jux4
:: (Pattern ControlMap -> Pattern ControlMap)
-> Pattern ControlMap -> Pattern ControlMap
jux4 :: (Pattern ControlMap -> Pattern ControlMap)
-> Pattern ControlMap -> Pattern ControlMap
jux4 f :: Pattern ControlMap -> Pattern ControlMap
f p :: Pattern ControlMap
p = [Pattern ControlMap] -> Pattern ControlMap
forall a. [Pattern a] -> Pattern a
stack [Pattern ControlMap
p Pattern ControlMap -> Pattern ControlMap -> Pattern ControlMap
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> Pattern ControlMap
P.pan (Double -> Pattern Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure (5Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/8)), Pattern ControlMap -> Pattern ControlMap
f (Pattern ControlMap -> Pattern ControlMap)
-> Pattern ControlMap -> Pattern ControlMap
forall a b. (a -> b) -> a -> b
$ Pattern ControlMap
p Pattern ControlMap -> Pattern ControlMap -> Pattern ControlMap
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> Pattern ControlMap
P.pan (Double -> Pattern Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure (1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/8))]
juxBy
:: Pattern Double
-> (Pattern ControlMap -> Pattern ControlMap)
-> Pattern ControlMap
-> Pattern ControlMap
juxBy :: Pattern Double
-> (Pattern ControlMap -> Pattern ControlMap)
-> Pattern ControlMap
-> Pattern ControlMap
juxBy n :: Pattern Double
n f :: Pattern ControlMap -> Pattern ControlMap
f p :: Pattern ControlMap
p = [Pattern ControlMap] -> Pattern ControlMap
forall a. [Pattern a] -> Pattern a
stack [Pattern ControlMap
p Pattern ControlMap -> Pattern ControlMap -> Pattern ControlMap
forall a. Num a => Pattern a -> Pattern a -> Pattern a
|+ Pattern Double -> Pattern ControlMap
P.pan 0.5 Pattern ControlMap -> Pattern ControlMap -> Pattern ControlMap
forall a. Num a => Pattern a -> Pattern a -> Pattern a
|- Pattern Double -> Pattern ControlMap
P.pan (Pattern Double
nPattern Double -> Pattern Double -> Pattern Double
forall a. Fractional a => a -> a -> a
/2), Pattern ControlMap -> Pattern ControlMap
f (Pattern ControlMap -> Pattern ControlMap)
-> Pattern ControlMap -> Pattern ControlMap
forall a b. (a -> b) -> a -> b
$ Pattern ControlMap
p Pattern ControlMap -> Pattern ControlMap -> Pattern ControlMap
forall a. Num a => Pattern a -> Pattern a -> Pattern a
|+ Pattern Double -> Pattern ControlMap
P.pan 0.5 Pattern ControlMap -> Pattern ControlMap -> Pattern ControlMap
forall a. Num a => Pattern a -> Pattern a -> Pattern a
|+ Pattern Double -> Pattern ControlMap
P.pan (Pattern Double
nPattern Double -> Pattern Double -> Pattern Double
forall a. Fractional a => a -> a -> a
/2)]
pick :: String -> Int -> String
pick :: String -> Int -> String
pick name :: String
name n :: Int
n = String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ ":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
samples :: Applicative f => f String -> f Int -> f String
samples :: f String -> f Int -> f String
samples p :: f String
p p' :: f Int
p' = String -> Int -> String
pick (String -> Int -> String) -> f String -> f (Int -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f String
p f (Int -> String) -> f Int -> f String
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' :: f String -> f Int -> f String
samples' p :: f String
p p' :: f Int
p' = (String -> Int -> String) -> Int -> String -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Int -> String
pick (Int -> String -> String) -> f Int -> f (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Int
p' f (String -> String) -> f String -> f String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f String
p
spreadf :: [a -> Pattern b] -> a -> Pattern b
spreadf :: [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 :: Pattern a -> [Pattern a] -> Pattern a
stackwith p :: Pattern a
p ps :: [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 (\(i :: Int
i, p' :: 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 [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 :: Pattern a -> Pattern a -> Pattern a -> Pattern a
range fromP :: Pattern a
fromP toP :: Pattern a
toP p :: Pattern a
p = (\from :: a
from to :: a
to v :: 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 :: b -> b -> f b -> f b
_range from :: b
from to :: b
to p :: 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 :: b -> b -> f b -> f b
rangex from :: b
from to :: b
to p :: 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 :: Pattern Rational
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
off tp :: Pattern Rational
tp f :: Pattern a -> Pattern a
f p :: Pattern a
p = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
innerJoin (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ (\tv :: 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 :: Rational -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_off t :: Rational
t f :: Pattern a -> Pattern a
f p :: 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 :: Pattern Rational -> Pattern a -> Pattern a -> Pattern a
offadd tp :: Pattern Rational
tp pn :: Pattern a
pn p :: 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 :: String -> String -> Pattern String
step s :: String
s cs :: String
cs = [Pattern String] -> Pattern String
forall a. [Pattern a] -> Pattern a
fastcat ([Pattern String] -> Pattern String)
-> [Pattern String] -> Pattern String
forall a b. (a -> b) -> a -> b
$ (Char -> Pattern String) -> String -> [Pattern String]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Pattern String
f String
cs
where f :: Char -> Pattern String
f c :: Char
c | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== 'x' = String -> Pattern String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
s
| Char -> Bool
isDigit Char
c = String -> Pattern String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Pattern String) -> String -> Pattern String
forall a b. (a -> b) -> a -> b
$ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ ":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
c]
| Bool
otherwise = Pattern String
forall a. Pattern a
silence
steps :: [(String, String)] -> Pattern String
steps :: [(String, String)] -> Pattern String
steps = [Pattern String] -> Pattern String
forall a. [Pattern a] -> Pattern a
stack ([Pattern String] -> Pattern String)
-> ([(String, String)] -> [Pattern String])
-> [(String, String)]
-> Pattern String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> Pattern String)
-> [(String, String)] -> [Pattern String]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String -> Pattern String)
-> (String, String) -> Pattern String
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> Pattern String
step)
step' :: [String] -> String -> Pattern String
step' :: [String] -> String -> Pattern String
step' ss :: [String]
ss cs :: String
cs = [Pattern String] -> Pattern String
forall a. [Pattern a] -> Pattern a
fastcat ([Pattern String] -> Pattern String)
-> [Pattern String] -> Pattern String
forall a b. (a -> b) -> a -> b
$ (Char -> Pattern String) -> String -> [Pattern String]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Pattern String
f String
cs
where f :: Char -> Pattern String
f c :: Char
c | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== 'x' = String -> Pattern String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Pattern String) -> String -> Pattern String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. [a] -> a
head [String]
ss
| Char -> Bool
isDigit Char
c = String -> Pattern String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Pattern String) -> String -> Pattern String
forall a b. (a -> b) -> a -> b
$ [String]
ss [String] -> Int -> String
forall a. [a] -> Int -> a
!! Char -> Int
digitToInt Char
c
| Bool
otherwise = Pattern String
forall a. Pattern a
silence
ghost'' :: Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
ghost'' :: Rational -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
ghost'' a :: Rational
a f :: Pattern a -> Pattern a
f p :: 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
*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
*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 ControlMap -> Pattern ControlMap
ghost' :: Rational -> Pattern ControlMap -> Pattern ControlMap
ghost' a :: Rational
a p :: Pattern ControlMap
p = Rational
-> (Pattern ControlMap -> Pattern ControlMap)
-> Pattern ControlMap
-> Pattern ControlMap
forall a.
Rational -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
ghost'' Rational
a ((Pattern ControlMap -> Pattern ControlMap -> Pattern ControlMap
forall (a :: * -> *) b. (Applicative a, Num b) => a b -> a b -> a b
|*| Pattern Double -> Pattern ControlMap
P.gain (Double -> Pattern Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure 0.7)) (Pattern ControlMap -> Pattern ControlMap)
-> (Pattern ControlMap -> Pattern ControlMap)
-> Pattern ControlMap
-> Pattern ControlMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pattern ControlMap -> Pattern ControlMap -> Pattern ControlMap
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
|> Pattern Double -> Pattern ControlMap
P.end (Double -> Pattern Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure 0.2)) (Pattern ControlMap -> Pattern ControlMap)
-> (Pattern ControlMap -> Pattern ControlMap)
-> Pattern ControlMap
-> Pattern ControlMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pattern ControlMap -> Pattern ControlMap -> Pattern ControlMap
forall (a :: * -> *) b. (Applicative a, Num b) => a b -> a b -> a b
|*| Pattern Double -> Pattern ControlMap
P.speed (Double -> Pattern Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure 1.25))) Pattern ControlMap
p
ghost :: Pattern ControlMap -> Pattern ControlMap
ghost :: Pattern ControlMap -> Pattern ControlMap
ghost = Rational -> Pattern ControlMap -> Pattern ControlMap
ghost' 0.125
tabby :: Int -> Pattern a -> Pattern a -> Pattern a
tabby :: Int -> Pattern a -> Pattern a -> Pattern a
tabby nInt :: Int
nInt p :: Pattern a
p 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 [[0..Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-1], [Integer] -> [Integer]
forall a. [a] -> [a]
reverse [0..Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-1]]) [0 .. (Integer
n Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` 2) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1]
warp :: [[Integer]]
warp = [[Integer]] -> [[Integer]]
forall a. [[a]] -> [[a]]
transpose [[Integer]]
weft
thread :: t [Integer] -> Pattern a -> Pattern a
thread xs :: t [Integer]
xs p'' :: 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
%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 (\i :: 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
+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 a.
Pattern Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
every 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
% 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 a.
Pattern Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
every 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
% 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 :: 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 :: Double -> [Pattern a] -> Pattern a
_select f :: Double
f ps :: [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 0 (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min 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
- 1))
selectF :: Pattern Double -> [Pattern a -> Pattern a] -> Pattern a -> Pattern a
selectF :: Pattern Double
-> [Pattern a -> Pattern a] -> Pattern a -> Pattern a
selectF pf :: Pattern Double
pf ps :: [Pattern a -> Pattern a]
ps p :: Pattern a
p = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
innerJoin (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ (\f :: 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 :: Double -> [Pattern a -> Pattern a] -> Pattern a -> Pattern a
_selectF f :: Double
f ps :: [Pattern a -> Pattern a]
ps p :: 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 0 (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min 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 :: Pattern Int -> [Pattern a -> Pattern a] -> Pattern a -> Pattern a
pickF pInt :: Pattern Int
pInt fs :: [Pattern a -> Pattern a]
fs pat :: 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
$ (\i :: 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 :: Int -> [Pattern a -> Pattern a] -> Pattern a -> Pattern a
_pickF i :: Int
i fs :: [Pattern a -> Pattern a]
fs p :: 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 ControlMap -> Pattern ControlMap)
-> (Pattern ControlMap -> Pattern ControlMap)
-> Pattern ControlMap
-> Pattern ControlMap
-> Pattern ControlMap
contrast = (Value -> Value -> Bool)
-> (Pattern ControlMap -> Pattern ControlMap)
-> (Pattern ControlMap -> Pattern ControlMap)
-> Pattern ControlMap
-> Pattern ControlMap
-> Pattern ControlMap
forall a b.
(a -> Value -> Bool)
-> (Pattern ControlMap -> Pattern b)
-> (Pattern ControlMap -> Pattern b)
-> Pattern (Map String a)
-> Pattern ControlMap
-> 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 :: (a -> Value -> Bool)
-> (Pattern ControlMap -> Pattern b)
-> (Pattern ControlMap -> Pattern b)
-> Pattern (Map String a)
-> Pattern ControlMap
-> Pattern b
contrastBy comp :: a -> Value -> Bool
comp f :: Pattern ControlMap -> Pattern b
f f' :: Pattern ControlMap -> Pattern b
f' p :: Pattern (Map String a)
p p' :: Pattern ControlMap
p' = Pattern b -> Pattern b -> Pattern b
forall a. Pattern a -> Pattern a -> Pattern a
overlay (Pattern ControlMap -> Pattern b
f Pattern ControlMap
matched) (Pattern ControlMap -> Pattern b
f' Pattern ControlMap
unmatched)
where matches :: Pattern (Bool, ControlMap)
matches = (ControlMap -> Map String a -> Bool)
-> Pattern (Map String a)
-> Pattern ControlMap
-> Pattern (Bool, ControlMap)
forall b a.
(b -> a -> Bool) -> Pattern a -> Pattern b -> Pattern (Bool, b)
matchManyToOne ((Map String a -> ControlMap -> Bool)
-> ControlMap -> Map String a -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Map String a -> ControlMap -> Bool)
-> ControlMap -> Map String a -> Bool)
-> (Map String a -> ControlMap -> Bool)
-> ControlMap
-> Map String a
-> Bool
forall a b. (a -> b) -> a -> b
$ (a -> Value -> Bool) -> Map String a -> ControlMap -> 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 String a)
p Pattern ControlMap
p'
matched :: ControlPattern
matched :: Pattern ControlMap
matched = Pattern (Maybe ControlMap) -> Pattern ControlMap
forall a. Pattern (Maybe a) -> Pattern a
filterJust (Pattern (Maybe ControlMap) -> Pattern ControlMap)
-> Pattern (Maybe ControlMap) -> Pattern ControlMap
forall a b. (a -> b) -> a -> b
$ (\(t :: Bool
t, a :: ControlMap
a) -> if Bool
t then ControlMap -> Maybe ControlMap
forall a. a -> Maybe a
Just ControlMap
a else Maybe ControlMap
forall a. Maybe a
Nothing) ((Bool, ControlMap) -> Maybe ControlMap)
-> Pattern (Bool, ControlMap) -> Pattern (Maybe ControlMap)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern (Bool, ControlMap)
matches
unmatched :: ControlPattern
unmatched :: Pattern ControlMap
unmatched = Pattern (Maybe ControlMap) -> Pattern ControlMap
forall a. Pattern (Maybe a) -> Pattern a
filterJust (Pattern (Maybe ControlMap) -> Pattern ControlMap)
-> Pattern (Maybe ControlMap) -> Pattern ControlMap
forall a b. (a -> b) -> a -> b
$ (\(t :: Bool
t, a :: ControlMap
a) -> if Bool -> Bool
not Bool
t then ControlMap -> Maybe ControlMap
forall a. a -> Maybe a
Just ControlMap
a else Maybe ControlMap
forall a. Maybe a
Nothing) ((Bool, ControlMap) -> Maybe ControlMap)
-> Pattern (Bool, ControlMap) -> Pattern (Maybe ControlMap)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern (Bool, ControlMap)
matches
contrastRange
:: (ControlPattern -> Pattern a)
-> (ControlPattern -> Pattern a)
-> Pattern (Map.Map String (Value, Value))
-> ControlPattern
-> Pattern a
contrastRange :: (Pattern ControlMap -> Pattern a)
-> (Pattern ControlMap -> Pattern a)
-> Pattern (Map String (Value, Value))
-> Pattern ControlMap
-> Pattern a
contrastRange = ((Value, Value) -> Value -> Bool)
-> (Pattern ControlMap -> Pattern a)
-> (Pattern ControlMap -> Pattern a)
-> Pattern (Map String (Value, Value))
-> Pattern ControlMap
-> Pattern a
forall a b.
(a -> Value -> Bool)
-> (Pattern ControlMap -> Pattern b)
-> (Pattern ControlMap -> Pattern b)
-> Pattern (Map String a)
-> Pattern ControlMap
-> Pattern b
contrastBy (Value, Value) -> Value -> Bool
f
where f :: (Value, Value) -> Value -> Bool
f (VI s :: Int
s, VI e :: Int
e) (VI v :: 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 s :: Double
s, VF e :: Double
e) (VF v :: 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 (VS s :: String
s, VS e :: String
e) (VS v :: String
v) = String
v String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
s Bool -> Bool -> Bool
&& String
v String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
e
f _ _ = Bool
False
fix :: (ControlPattern -> ControlPattern) -> ControlPattern -> ControlPattern -> ControlPattern
fix :: (Pattern ControlMap -> Pattern ControlMap)
-> Pattern ControlMap -> Pattern ControlMap -> Pattern ControlMap
fix f :: Pattern ControlMap -> Pattern ControlMap
f = (Pattern ControlMap -> Pattern ControlMap)
-> (Pattern ControlMap -> Pattern ControlMap)
-> Pattern ControlMap
-> Pattern ControlMap
-> Pattern ControlMap
contrast Pattern ControlMap -> Pattern ControlMap
f Pattern ControlMap -> Pattern ControlMap
forall a. a -> a
id
unfix :: (ControlPattern -> ControlPattern) -> ControlPattern -> ControlPattern -> ControlPattern
unfix :: (Pattern ControlMap -> Pattern ControlMap)
-> Pattern ControlMap -> Pattern ControlMap -> Pattern ControlMap
unfix = (Pattern ControlMap -> Pattern ControlMap)
-> (Pattern ControlMap -> Pattern ControlMap)
-> Pattern ControlMap
-> Pattern ControlMap
-> Pattern ControlMap
contrast Pattern ControlMap -> Pattern ControlMap
forall a. a -> a
id
fixRange :: (ControlPattern -> Pattern ControlMap)
-> Pattern (Map.Map String (Value, Value))
-> ControlPattern
-> Pattern ControlMap
fixRange :: (Pattern ControlMap -> Pattern ControlMap)
-> Pattern (Map String (Value, Value))
-> Pattern ControlMap
-> Pattern ControlMap
fixRange f :: Pattern ControlMap -> Pattern ControlMap
f = (Pattern ControlMap -> Pattern ControlMap)
-> (Pattern ControlMap -> Pattern ControlMap)
-> Pattern (Map String (Value, Value))
-> Pattern ControlMap
-> Pattern ControlMap
forall a.
(Pattern ControlMap -> Pattern a)
-> (Pattern ControlMap -> Pattern a)
-> Pattern (Map String (Value, Value))
-> Pattern ControlMap
-> Pattern a
contrastRange Pattern ControlMap -> Pattern ControlMap
f Pattern ControlMap -> Pattern ControlMap
forall a. a -> a
id
unfixRange :: (ControlPattern -> Pattern ControlMap)
-> Pattern (Map.Map String (Value, Value))
-> ControlPattern
-> Pattern ControlMap
unfixRange :: (Pattern ControlMap -> Pattern ControlMap)
-> Pattern (Map String (Value, Value))
-> Pattern ControlMap
-> Pattern ControlMap
unfixRange = (Pattern ControlMap -> Pattern ControlMap)
-> (Pattern ControlMap -> Pattern ControlMap)
-> Pattern (Map String (Value, Value))
-> Pattern ControlMap
-> Pattern ControlMap
forall a.
(Pattern ControlMap -> Pattern a)
-> (Pattern ControlMap -> Pattern a)
-> Pattern (Map String (Value, Value))
-> Pattern ControlMap
-> Pattern a
contrastRange Pattern ControlMap -> Pattern ControlMap
forall a. a -> a
id
quantise :: (Functor f, RealFrac b) => b -> f b -> f b
quantise :: b -> f b -> f b
quantise n :: 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))
inv :: Functor f => f Bool -> f Bool
inv :: 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 :: Pattern a -> Pattern a
mono p :: Pattern a
p = Query a -> Pattern a
forall a. Query a -> Pattern a
Pattern (Query a -> Pattern a) -> Query a -> Pattern a
forall a b. (a -> b) -> a -> b
$ \(State a :: Arc
a cm :: StateMap
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 -> Query a
forall a. Pattern a -> Query a
query Pattern a
p (Arc -> StateMap -> State
State Arc
a StateMap
cm) where
flatten :: [Event a] -> [Event a]
flatten :: [Event a] -> [Event a]
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 (e :: Event a
e:es :: [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 a :: Event a
a b :: 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 :: Event a -> Maybe (Event a)
constrainPart e :: 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 :: Pattern a -> Pattern a
smooth p :: Pattern a
p = Query a -> Pattern a
forall a. Query a -> Pattern a
Pattern (Query a -> Pattern a) -> Query a -> Pattern a
forall a b. (a -> b) -> a -> b
$ \st :: State
st@(State a :: Arc
a cm :: StateMap
cm) -> State -> Arc -> [EventF Arc a] -> [EventF Arc a]
forall a. State -> a -> [EventF Arc a] -> [EventF a a]
tween State
st Arc
a ([EventF Arc a] -> [EventF Arc a])
-> [EventF Arc a] -> [EventF Arc a]
forall a b. (a -> b) -> a -> b
$ Pattern a -> Query a
forall a. Pattern a -> Query a
query Pattern a
monoP (Arc -> StateMap -> State
State (Arc -> Arc
forall a. Fractional a => ArcF a -> ArcF a
midArc Arc
a) StateMap
cm)
where
midArc :: ArcF a -> ArcF a
midArc a :: 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 -> [EventF Arc a] -> [EventF a a]
tween _ _ [] = []
tween st :: State
st queryA :: a
queryA (e :: EventF Arc a
e:_) = [EventF a a] -> (a -> [EventF a a]) -> Maybe a -> [EventF a a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [EventF Arc 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 (EventF Arc a -> Rational
forall a. Event a -> Rational
wholeStop EventF Arc a
e) (EventF Arc a -> Rational
forall a. Event a -> Rational
wholeStop EventF Arc a
e)
nextEs :: Query a
nextEs st' :: State
st' = Pattern a -> Query a
forall a. Pattern a -> Query a
query Pattern a
monoP (State
st' {arc :: Arc
arc = Arc
aStop})
nextV :: State -> Maybe a
nextV st' :: State
st' | [EventF Arc a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Query 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
$ EventF Arc a -> a
forall a b. EventF a b -> b
value ([EventF Arc a] -> EventF Arc a
forall a. [a] -> a
head (Query a
nextEs State
st'))
tween' :: a -> a -> [EventF a a]
tween' queryA' :: a
queryA' v :: a
v =
[ Event :: forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event
{ context :: Context
context = EventF Arc a -> Context
forall a b. EventF a b -> Context
context EventF Arc 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 = EventF Arc a -> a
forall a b. EventF a b -> b
value EventF Arc a
e a -> a -> a
forall a. Num a => a -> a -> a
+ ((a
v a -> a -> a
forall a. Num a => a -> a -> a
- EventF Arc a -> a
forall a b. EventF a b -> b
value EventF Arc 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' (EventF Arc a -> Arc
forall a. Event a -> Arc
wholeOrPart EventF Arc a
e) Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = 0
| Bool
otherwise = Rational -> a
forall a. Fractional a => Rational -> a
fromRational (Rational -> a) -> Rational -> a
forall a b. (a -> b) -> a -> b
$ (EventF Arc a -> Rational
forall a. Event a -> Rational
eventPartStart EventF Arc a
e Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- EventF Arc a -> Rational
forall a. Event a -> Rational
wholeStart EventF Arc a
e) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Arc -> Rational
forall a. Num a => ArcF a -> a
delta' (EventF Arc a -> Arc
forall a. Event a -> Arc
wholeOrPart EventF Arc a
e)
delta' :: ArcF a -> a
delta' a :: 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 :: [(a, b)] -> Pattern a -> Pattern b
swap things :: [(a, b)]
things p :: 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 :: Int
-> (Pattern a -> Pattern a -> Pattern a)
-> (Pattern a -> Pattern a)
-> Pattern a
-> Pattern a
snowball depth :: Int
depth combinationFunction :: Pattern a -> Pattern a -> Pattern a
combinationFunction f :: Pattern a -> Pattern a
f pattern :: 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
$ (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 :: Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
soak depth :: Int
depth f :: Pattern a -> Pattern a
f pattern :: 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 String -> String
deconstruct n :: Int
n p :: Pattern String
p = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate " " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [String] -> String
showStep ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$ Pattern String -> [[String]]
forall a. Pattern a -> [[a]]
toList Pattern String
p
where
showStep :: [String] -> String
showStep :: [String] -> String
showStep [] = "~"
showStep [x :: String
x] = String
x
showStep xs :: [String]
xs = "[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate ", " [String]
xs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "]"
toList :: Pattern a -> [[a]]
toList :: Pattern a -> [[a]]
toList pat :: Pattern a
pat = ((Rational, Rational) -> [a]) -> [(Rational, Rational)] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (\(s :: Rational
s,e :: 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 = [0, (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 1 [Rational]
breaks)
n' :: Rational
n' = Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
bite :: Int -> Pattern Int -> Pattern a -> Pattern a
bite :: Int -> Pattern Int -> Pattern a -> Pattern a
bite n :: Int
n ipat :: Pattern Int
ipat pat :: 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 i :: 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
+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 :: Pattern Int -> [Pattern a] -> Pattern a
squeeze _ [] = Pattern a
forall a. Pattern a
silence
squeeze ipat :: Pattern Int
ipat pats :: [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 ControlMap) -> Pattern ControlMap
squeezeJoinUp pp :: Pattern (Pattern ControlMap)
pp = Pattern (Pattern ControlMap)
pp {query :: Query ControlMap
query = Query ControlMap
q}
where q :: Query ControlMap
q st :: State
st = (EventF Arc (Pattern ControlMap) -> [EventF Arc ControlMap])
-> [EventF Arc (Pattern ControlMap)] -> [EventF Arc ControlMap]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (State -> EventF Arc (Pattern ControlMap) -> [EventF Arc ControlMap]
f State
st) (Pattern (Pattern ControlMap) -> Query (Pattern ControlMap)
forall a. Pattern a -> Query a
query (Pattern (Pattern ControlMap) -> Pattern (Pattern ControlMap)
forall a. Pattern a -> Pattern a
filterDigital Pattern (Pattern ControlMap)
pp) State
st)
f :: State -> EventF Arc (Pattern ControlMap) -> [EventF Arc ControlMap]
f st :: State
st (Event c :: Context
c (Just w :: Arc
w) p :: Arc
p v :: Pattern ControlMap
v) =
(EventF Arc ControlMap -> Maybe (EventF Arc ControlMap))
-> [EventF Arc ControlMap] -> [EventF Arc ControlMap]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Context
-> Arc
-> Arc
-> EventF Arc ControlMap
-> Maybe (EventF Arc ControlMap)
forall b.
Context -> Arc -> Arc -> EventF Arc b -> Maybe (EventF Arc b)
munge Context
c Arc
w Arc
p) ([EventF Arc ControlMap] -> [EventF Arc ControlMap])
-> [EventF Arc ControlMap] -> [EventF Arc ControlMap]
forall a b. (a -> b) -> a -> b
$ Pattern ControlMap -> Query ControlMap
forall a. Pattern a -> Query a
query (Arc -> Pattern ControlMap -> Pattern ControlMap
forall a. Arc -> Pattern a -> Pattern a
compressArc (Arc -> Arc
cycleArc Arc
w) (Pattern ControlMap
v Pattern ControlMap -> Pattern ControlMap -> Pattern ControlMap
forall a. Num a => Pattern a -> Pattern a -> Pattern a
|* Pattern Double -> Pattern ControlMap
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
$ 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 _ _ = []
munge :: Context -> Arc -> Arc -> EventF Arc b -> Maybe (EventF Arc b)
munge co :: Context
co oWhole :: Arc
oWhole oPart :: Arc
oPart (Event ci :: Context
ci (Just iWhole :: Arc
iWhole) iPart :: Arc
iPart v :: 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 _ _ _ _ = Maybe (EventF Arc b)
forall a. Maybe a
Nothing
chew :: Int -> Pattern Int -> ControlPattern -> ControlPattern
chew :: Int -> Pattern Int -> Pattern ControlMap -> Pattern ControlMap
chew n :: Int
n ipat :: Pattern Int
ipat pat :: Pattern ControlMap
pat = (Pattern (Pattern ControlMap) -> Pattern ControlMap
squeezeJoinUp (Pattern (Pattern ControlMap) -> Pattern ControlMap)
-> Pattern (Pattern ControlMap) -> Pattern ControlMap
forall a b. (a -> b) -> a -> b
$ Int -> Pattern ControlMap
zoompat (Int -> Pattern ControlMap)
-> Pattern Int -> Pattern (Pattern ControlMap)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Int
ipat) Pattern ControlMap -> Pattern ControlMap -> Pattern ControlMap
forall a. Fractional a => Pattern a -> Pattern a -> Pattern a
|/ Pattern Double -> Pattern ControlMap
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 ControlMap
zoompat i :: Int
i = (Rational, Rational) -> Pattern ControlMap -> Pattern ControlMap
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
+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 ControlMap
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
__binary :: Data.Bits.Bits b => Int -> b -> [Bool]
__binary :: Int -> b -> [Bool]
__binary n :: Int
n num :: 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 [0 .. Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1]
_binary :: Data.Bits.Bits b => Int -> b -> Pattern Bool
_binary :: Int -> b -> Pattern Bool
_binary n :: Int
n num :: 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 n :: Int
n p :: 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
binary :: Pattern Int -> Pattern Bool
binary :: Pattern Int -> Pattern Bool
binary = Int -> Pattern Int -> Pattern Bool
binaryN 8
ascii :: Pattern String -> Pattern Bool
ascii :: Pattern String -> Pattern Bool
ascii p :: Pattern String
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)
-> (String -> [Bool]) -> String -> Pattern Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> [Bool]) -> String -> [Bool]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> Int -> [Bool]
forall b. Bits b => Int -> b -> [Bool]
__binary 8 (Int -> [Bool]) -> (Char -> Int) -> Char -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord)) (String -> Pattern Bool)
-> Pattern String -> Pattern (Pattern Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern String
p