module Sound.SC3.Lang.Pattern.Stream where
import Data.List
import Data.Maybe
import System.Random
import qualified Sound.SC3 as S
import Sound.SC3.Lang.Core
import qualified Sound.SC3.Lang.Math as M
import qualified Sound.SC3.Lang.Random.Gen as R
rsd :: (Eq a) => [a] -> [a]
rsd =
let f (p,_) i = (Just i,if Just i == p then Nothing else Just i)
in mapMaybe snd . scanl f (Nothing,Nothing)
iEq :: Eq a => [a] -> [a] -> Bool
iEq = flip isPrefixOf
take_until_forms_set :: Eq a => [a] -> [a] -> [a]
take_until_forms_set s l =
if null s
then []
else case l of
[] -> []
e:l' -> e : take_until_forms_set (delete e s) l'
brown_ :: (RandomGen g,Random n,Num n,Ord n) => (n,n,n) -> (n,g) -> (n,g)
brown_ (l,r,s) (n,g) =
let (i,g') = randomR (s,s) g
in (S.foldToRange l r (n + i),g')
brown :: (Enum e,Random n,Num n,Ord n) => e -> [n] -> [n] -> [n] -> [n]
brown e l_ r_ s_ =
let i = (randomR (head l_,head r_) (mkStdGen (fromEnum e)))
rec (n,g) z =
case z of
[] -> []
(l,r,s):z' -> let (n',g') = brown_ (l,r,s) (n,g)
in n' : rec (n',g') z'
in rec i (zip3 l_ r_ s_)
exprand :: (Enum e,Random a,Floating a) => e -> a -> a -> [a]
exprand e l r = fmap (M.exprange l r) (white e 0 1)
geom :: Num a => a -> a -> [a]
geom i s = iterate (* s) i
lace :: [[a]] -> [a]
lace = concat . transpose . map cycle
rand :: Enum e => e -> [a] -> [a]
rand e a =
let k = length a 1
in map (a !!) (white e 0 k)
segment :: [a] -> Int -> (Int,Int) -> [a]
segment a k (l,r) =
let i = map (S.genericWrap 0 (k 1)) [l .. r]
in map (a !!) i
slide :: [a] -> Int -> Int -> Int -> Bool -> [[a]]
slide a j s i wr =
let k = length a
l = enumFromThen i (i + s)
r = map (+ (j 1)) l
in if wr
then map (segment a k) (zip l r)
else error "slide: non-wrap variant not implemented"
slidec :: [a] -> Int -> Int -> Int -> Bool -> [a]
slidec = concat .:::: slide
white :: (Random n,Enum e) => e -> n -> n -> [n]
white e l r = randomRs (l,r) (mkStdGen (fromEnum e))
wrand_generic :: (Enum e,Fractional n,Ord n,Random n) => e -> [a] -> [n] -> [a]
wrand_generic e a w =
let f g = let (r,g') = R.wchoose a w g
in r : f g'
in if length a /= length w
then error "wrand_generic: a/w must be of equal length"
else f (mkStdGen (fromEnum e))
wrand :: Enum e => e -> [a] -> [Double] -> [a]
wrand = wrand_generic
xrand :: Enum e => e -> [a] -> [a]
xrand e a =
let g = mkStdGen (fromEnum e)
k = length a 1
r = rsd (randomRs (0,k) g)
in map (a !!) r