module Csound.Air (
osc, oscBy, saw, sq, tri,
unipolar, uosc, uoscBy, usaw, usq, utri,
lp, hp, bp, br,
blp, bhp, bbp, bbr,
once, several, sine, mean,
hase, whase,
haseS, whaseS,
cfd, cfds, cfdSpec, cfdsSpec
) where
import Csound.Exp(Tab)
import Csound.Exp.Wrapper(Sig, Spec, sig, kr, Cps)
import Csound.Exp.SE
import Csound.Opcode(idur, oscil3, pvscross,
atone, tone, areson, reson,
buthp, butbp, butlp, butbr)
import Csound.Tab(sines)
osc :: Cps -> Sig
osc cps = oscil3 1 cps (sines [1])
oscBy :: Tab -> Cps -> Sig
oscBy tab cps = oscil3 1 cps tab
resolution :: Int
resolution = 12
saw :: Cps -> Sig
saw cps = oscil3 1 cps (sines $ take resolution $ fmap (1 / ) [1 .. ])
sq :: Cps -> Sig
sq cps = oscil3 1 cps (sines $ take resolution $ fmap f [(1::Int) .. ])
where f :: Int -> Double
f x
| even x = 0
| otherwise = 1 / fromIntegral x
tri :: Cps -> Sig
tri cps = oscil3 1 cps (sines $ take resolution $ zipWith f (cycle [1, 1]) [1 ..])
where f :: Double -> Int -> Double
f a x
| even x = 0
| otherwise = a / fromIntegral (x ^ (2::Int))
unipolar :: Sig -> Sig
unipolar a = 0.5 + 0.5 * a
uosc :: Cps -> Sig
uosc = unipolar . osc
uoscBy :: Tab -> Cps -> Sig
uoscBy tab = unipolar . oscBy tab
usaw :: Cps -> Sig
usaw = unipolar . saw
usq :: Cps -> Sig
usq = unipolar . sq
utri :: Cps -> Sig
utri = unipolar . tri
hp :: Sig -> Sig -> Sig
hp = flip atone
lp :: Sig -> Sig -> Sig
lp = flip tone
bp :: Sig -> Sig -> Sig -> Sig
bp freq band a = reson a freq band
br :: Sig -> Sig -> Sig -> Sig
br freq band a = areson a freq band
bhp :: Sig -> Sig -> Sig
bhp = flip buthp
blp :: Sig -> Sig -> Sig
blp = flip butlp
bbp :: Sig -> Sig -> Sig -> Sig
bbp freq band a = butbp a freq band
bbr :: Sig -> Sig -> Sig -> Sig
bbr freq band a = butbr a freq band
sine :: Tab
sine = sines [1]
once :: Tab -> Sig
once a = kr $ oscil3 1 (1 / sig idur) a
several :: Tab -> Sig -> Sig
several tab rate = kr $ oscil3 1 (rate / sig idur) tab
mean :: Fractional a => [a] -> a
mean xs = sum xs / (fromIntegral $ length xs)
hase :: (a -> Sig -> Sig) -> [a] -> Sig -> Sig
hase f as x = mean $ fmap (( $ x) . f) as
whase :: (a -> Sig -> Sig) -> [(Sig, a)] -> Sig -> Sig
whase f as x = sum $ fmap (\(weight, param) -> weight * f param x) as
haseS :: (a -> Sig -> SE Sig) -> [a] -> Sig -> SE Sig
haseS mf as x = fmap mean $ mapM (\param -> mf param x) as
whaseS :: (a -> Sig -> SE Sig) -> [(Sig, a)] -> Sig -> SE Sig
whaseS mf as x = fmap sum $ mapM (\(weight, param) -> fmap (weight * ) (mf param x)) as
cfd :: Sig -> Sig -> Sig -> Sig
cfd coeff a b = (1 coeff) * a + coeff * b
genCfds :: a -> (Sig -> a -> a -> a) -> [Sig] -> [a] -> a
genCfds zero mixFun cs xs = case xs of
[] -> zero
a:as -> foldl (\x f -> f x) a $ zipWith mix' cs as
where mix' c a b = mixFun c b a
cfds :: [Sig] -> [Sig] -> Sig
cfds = genCfds 0 cfd
cfdSpec :: Sig -> Spec -> Spec -> Spec
cfdSpec coeff a b = pvscross a b (1 coeff) coeff
cfdsSpec :: [Sig] -> [Spec] -> Spec
cfdsSpec = genCfds undefined cfdSpec