module Csound.Air.Misc(
mean, vibrate, randomPitch, chorusPitch, resons, resonsBy, modes, dryWet,
once, onceBy, several, fromMono,
odds, evens,
rndPan, rndPan2, rndVol, gaussVol,
selector,
writeHifi,
arpeggi, arpBy,
lpJoy,
funSeq, funPar
) where
import Data.Boolean
import Csound.Typed
import Csound.Typed.Opcode
import Csound.Control.Gui
import Csound.Air.Wave
import Csound.Air.Envelope
import Csound.Air.Filter
import Csound.SigSpace
import Csound.IO(writeSndBy)
import Csound.Options(setRates)
import Csound.Types(Sig2)
odds :: [a] -> [a]
odds as = fmap snd $ filter fst $ zip (cycle [True, False]) as
evens :: [a] -> [a]
evens as
| null as = []
| otherwise = odds $ tail as
once :: Tab -> Sig
once = onceBy idur
onceBy :: D -> Tab -> Sig
onceBy dt tb = kr $ oscBy tb (1 / sig dt)
several :: Tab -> Sig -> Sig
several tb rate = kr $ oscil3 1 (rate / sig idur) tb
mean :: Fractional a => [a] -> a
mean xs = sum xs / (fromIntegral $ length xs)
vibrate :: Sig -> Sig -> (Sig -> a) -> (Sig -> a)
vibrate vibDepth vibRate f cps = f (cps * (1 + kvib))
where kvib = vibDepth * kr (osc vibRate)
randomPitch :: Sig -> Sig -> (Sig -> a) -> (Sig -> SE a)
randomPitch rndAmp rndCps f cps = fmap go $ randh (cps * rndAmp) rndCps
where go krand = f (cps + krand)
chorusPitch :: Int -> Sig -> (Sig -> Sig) -> Sig -> Sig
chorusPitch n wid = phi dts
where
phi :: [Sig] -> (Sig -> Sig) -> Sig -> Sig
phi ks f = \cps -> mean $ fmap (f . (+ cps)) ks
dts = fmap (\x -> wid + fromIntegral x * dt) [0 .. n1]
dt = 2 * wid / fromIntegral n
resons :: [(Sig, Sig)] -> Sig -> Sig
resons = resonsBy bp
resonsBy :: (cps -> bw -> Sig -> Sig) -> [(cps, bw)] -> Sig -> Sig
resonsBy filt ps asig = mean $ fmap (( $ asig) . uncurry filt) ps
dryWet :: Sig -> (Sig -> Sig) -> Sig -> Sig
dryWet k ef asig = k * asig + (1 k) * ef asig
modes :: [(Sig, Sig)] -> Sig -> Sig -> Sig
modes = relResonsBy (\cf q asig -> mode asig cf q)
relResonsBy :: (Sig -> a -> Sig -> Sig) -> [(Sig, a)] -> Sig -> Sig -> Sig
relResonsBy resonator ms baseCps apulse = (recip normFactor * ) $ sum $ fmap (\(cf, q) -> harm cf q apulse) ms
where
gate :: Sig -> Sig
gate cps = ifB (sig getSampleRate >* pi * cps) 1 0
normFactor = sum $ fmap (gate . (* baseCps) . fst) ms
harm cf q x = g * resonator (1 g + g * cps) q x
where cps = cf * baseCps
g = gate cps
fromMono :: Sig -> (Sig, Sig)
fromMono a = (a, a)
rndPan2 :: Sig2 -> SE Sig2
rndPan2 (a, b) = rndPan $ mean [a, b]
rndPan :: Sig -> SE Sig2
rndPan a = do
return $ pan2 a (sig $ rnd (1 :: D))
gaussVol :: SigSpace a => D -> a -> SE a
gaussVol k a = do
level <- fmap ir $ gauss (sig k)
return $ mul (sig $ level + 1) a
rndVol :: SigSpace a => (D, D) -> a -> SE a
rndVol (kMin, kMax) a = do
let level = rnd (1 :: D)
return $ mul (sig $ kMin + (kMax kMin) * level) a
writeHifi :: D -> String -> SE Sig2 -> IO ()
writeHifi n fileName a = writeSndBy (setRates 48000 10) fileName $ fmap (setDur $ n) a
selector :: (Num a, SigSpace a) => [a] -> Sig -> a
selector as k = sum $ zipWith choice [0..] as
where choice n a = mul (port (ifB (sig (int n) ==* k) 1 0) 0.02) a
arpeggi :: SigSpace a => [Sig] -> [Sig] -> (Sig -> a) -> Sig -> a
arpeggi = arpBy triSeq sqrSeq
arpBy :: SigSpace a => ([Sig] -> Sig -> Sig) -> ([Sig] -> Sig -> Sig) -> [Sig] -> [Sig] -> (Sig -> a) -> Sig -> a
arpBy ampWave cpsWave amps cpss wave dt = mul (ampWave amps dt) $ wave $ cpsWave cpss dt
lpJoy :: Source (Sig -> Sig)
lpJoy = lift1 (\(cps, res) -> mlp cps res) $ joy (expSpan 100 17000) (linSpan 0.05 0.95) (1400, 0.5)
funSeq :: [a -> a] -> a -> a
funSeq = foldl (.) id
funPar :: Num a => [a -> a] -> a -> a
funPar fs a = sum $ fmap ($ a) fs