module Csound.Air.Filter(
lp1, hp1,
lp, hp, bp, br, alp,
bp2, br2,
blp, bhp, bbp, bbr,
ResonFilter, FlatFilter,
filt, flatFilt, toReson,
mlp, mlp2, mlp3, lp18, ladder,
formant, singA, singO, singE, singU, singO2,
smooth, slide,
alp1, alp2, alp3, alp4, ahp,
mvchpf, mvclpf1, mvclpf2, mvclpf3, mvclpf4,
zdf1, zlp1, zhp1, zap1,
zdf2, zlp, zbp, zhp, zdf2_notch, zbr,
zladder,
zdf4, zlp4, zbp4, zhp4,
peakEq, highShelf, lowShelf,
lpCheb1, lpCheb1', lpCheb2, lpCheb2', clp, clp',
hpCheb1, hpCheb1', hpCheb2, hpCheb2', chp, chp',
plastic, wobble, trumpy, harsh,
tbf, diode, linDiode, noNormDiode,
linKorg_lp, linKorg_hp, korg_lp, korg_hp,
slp, shp, sbp, sbr,
multiStatevar, multiSvfilter
) where
import Control.Applicative
import Csound.Typed
import Csound.Typed.Plugins
import Csound.SigSpace(bat)
import Csound.Typed.Opcode
import Control.Monad.Trans.Class
import Csound.Dynamic
lp :: Sig -> Sig -> Sig -> Sig
lp cf q a = bqrez a cf q
hp :: Sig -> Sig -> Sig -> Sig
hp cf q a = bqrez a cf q `withD` 1
bp :: Sig -> Sig -> Sig -> Sig
bp cf q a = bqrez a cf q `withD` 2
br :: Sig -> Sig -> Sig -> Sig
br cf q a = bqrez a cf q `withD` 3
alp :: Sig -> Sig -> Sig -> Sig
alp cf q a = bqrez a cf q `withD` 4
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
mlp :: Sig -> Sig -> Sig -> Sig
mlp cf q asig = moogvcf asig cf q
slide :: Sig -> Sig -> Sig
slide = flip lineto
smooth :: Sig -> Sig -> Sig
smooth = flip portk
type ResonFilter = Sig -> Sig -> Sig -> Sig
type FlatFilter = Sig -> Sig -> Sig
toReson :: FlatFilter -> ResonFilter
toReson filter = \cfq res -> filter cfq
filt :: Int -> ResonFilter -> ResonFilter
filt n f cfq q asig = (foldl (.) id $ replicate n (f cfq q)) asig
flatFilt :: Int -> FlatFilter -> FlatFilter
flatFilt n f cfq asig = (foldl (.) id $ replicate n (f cfq)) asig
lp18 :: Sig -> Sig -> Sig -> Sig -> Sig
lp18 dist cfq q asig = lpf18 asig cfq q dist
mlp2 :: Sig -> Sig -> Sig -> Sig
mlp2 cfq q asig = moogladder asig cfq q
mlp3 :: Sig -> Sig -> Sig -> Sig
mlp3 = lp18 0
lp1 :: Sig -> Sig -> Sig
lp1 cfq asig = tone asig cfq
hp1 :: Sig -> Sig -> Sig
hp1 cfq asig = atone asig cfq
bp2 :: Sig -> Sig -> Sig -> Sig
bp2 cfq q asig = reson asig cfq q
br2 :: Sig -> Sig -> Sig -> Sig
br2 cfq q asig = areson asig cfq q
formant :: ResonFilter -> [(Sig, Sig)] -> Sig -> Sig
formant f qs asig = sum (fmap (( $ asig) . uncurry f) qs)
singA :: Sig -> Sig
singA = bat (formant bp2 anA)
singO :: Sig -> Sig
singO = bat (formant bp2 anO)
singE :: Sig -> Sig
singE = bat (formant bp2 anE)
singU :: Sig -> Sig
singU = bat (formant bp2 anIY)
singO2 :: Sig -> Sig
singO2 = bat (formant bp2 anO2)
anO = [(280, 20), (650, 25), (2200, 30), (3450, 40), (4500, 50)]
anA = [(650, 50), (1100, 50), (2860, 50), (3300, 50), (4500, 50)]
anE = [(500, 50), (1750, 50), (2450, 50), (3350, 50), (5000, 50)]
anIY = [(330, 50), (2000, 50), (2800, 50), (3650, 50), (5000, 50)]
anO2 = [(400, 50), (840, 50), (2800, 50), (3250, 50), (4500, 50)]
alp1 :: Sig -> Sig -> Sig -> Sig
alp1 freq reson asig = mvclpf1 asig freq reson
alp2 :: Sig -> Sig -> Sig -> Sig
alp2 freq reson asig = mvclpf2 asig freq reson
alp3 :: Sig -> Sig -> Sig -> Sig
alp3 freq reson asig = mvclpf3 asig freq reson
alp4 :: Sig -> Sig -> Sig -> Sig
alp4 freq reson asig = mvclpf4 asig freq reson
ahp :: Sig -> Sig -> Sig
ahp freq asig = mvchpf asig freq
mvchpf :: Sig -> Sig -> Sig
mvchpf b1 b2 = Sig $ f <$> unSig b1 <*> unSig b2
where f a1 a2 = opcs "mvchpf" [(Ar,[Ar,Xr,Ir])] [a1,a2]
mvclpf1 :: Sig -> Sig -> Sig -> Sig
mvclpf1 = genMvclpf "mvclpf1"
mvclpf2 :: Sig -> Sig -> Sig -> Sig
mvclpf2 = genMvclpf "mvclpf2"
mvclpf3 :: Sig -> Sig -> Sig -> Sig
mvclpf3 = genMvclpf "mvclpf3"
mvclpf4 :: Sig -> Sig -> Sig -> Sig
mvclpf4 = genMvclpf "mvclpf4"
genMvclpf :: String -> Sig -> Sig -> Sig -> Sig
genMvclpf name b1 b2 b3 = Sig $ f <$> unSig b1 <*> unSig b2 <*> unSig b3
where f a1 a2 a3 = opcs name [(Ar,[Ar,Xr,Xr,Ir])] [a1,a2,a3]
lpCheb1 :: Sig -> Sig -> Sig
lpCheb1 = lpCheb1' 2
lpCheb1' :: D -> Sig -> Sig -> Sig
lpCheb1' npoles kcf asig = clfilt asig kcf 0 npoles `withD` 1
lpCheb2 :: Sig -> Sig -> Sig
lpCheb2 = lpCheb2' 2
lpCheb2' :: D -> Sig -> Sig -> Sig
lpCheb2' npoles kcf asig = clfilt asig kcf 0 npoles `withD` 2
clp :: Sig -> Sig -> Sig
clp = clp' 2
clp' :: D -> Sig -> Sig -> Sig
clp' npoles kcf asig = clfilt asig kcf 0 npoles `withD` 0
hpCheb1 :: Sig -> Sig -> Sig
hpCheb1 = hpCheb1' 2
hpCheb1' :: D -> Sig -> Sig -> Sig
hpCheb1' npoles kcf asig = clfilt asig kcf 1 npoles `withD` 1
hpCheb2 :: Sig -> Sig -> Sig
hpCheb2 = hpCheb2' 2
hpCheb2' :: D -> Sig -> Sig -> Sig
hpCheb2' npoles kcf asig = clfilt asig kcf 1 npoles `withD` 2
chp :: Sig -> Sig -> Sig
chp = clp' 2
chp' :: D -> Sig -> Sig -> Sig
chp' npoles kcf asig = clfilt asig kcf 1 npoles `withD` 0
mkBp :: FlatFilter -> FlatFilter -> Sig -> Sig -> Sig -> Sig
mkBp lowPass highPass cfq bw asig = highPass (cfq rad) $ lowPass (cfq + rad) asig
where rad = bw / 2
bpCheb1 :: Sig -> Sig -> Sig -> Sig
bpCheb1 = bpCheb1' 2
bpCheb1' :: D -> Sig -> Sig -> Sig -> Sig
bpCheb1' npoles = mkBp (lpCheb1' npoles) (hpCheb1' npoles)
bpCheb2 :: Sig -> Sig -> Sig -> Sig
bpCheb2 = bpCheb2' 2
bpCheb2' :: D -> Sig -> Sig -> Sig -> Sig
bpCheb2' npoles = mkBp (lpCheb2' npoles) (hpCheb2' npoles)
cbp :: Sig -> Sig -> Sig -> Sig
cbp = cbp' 2
cbp' :: D -> Sig -> Sig -> Sig -> Sig
cbp' npoles = mkBp (clp' npoles) (chp' npoles)
mkReson :: FlatFilter -> FlatFilter -> ResonFilter
mkReson lowPass highPass kcf res asig = 0.5 * (lowPass (kcf * 2) asig + bandPass bw kcf asig)
where
bw = kcf / (0.001 + abs res)
bandPass = mkBp lowPass highPass
cheb1 :: Sig -> Sig -> Sig -> Sig
cheb1 = cheb1' 2
cheb1' :: D -> Sig -> Sig -> Sig -> Sig
cheb1' npoles = mkReson (lpCheb1' npoles) (hpCheb1' npoles)
cheb2 :: Sig -> Sig -> Sig -> Sig
cheb2 = cheb2' 2
cheb2' :: D -> Sig -> Sig -> Sig -> Sig
cheb2' npoles = mkReson (lpCheb2' npoles) (hpCheb2' npoles)
vcf :: Sig -> Sig -> Sig -> Sig
vcf = cbp' 2
vcf' :: D -> Sig -> Sig -> Sig -> Sig
vcf' npoles = mkReson (clp' npoles) (chp' npoles)
ladder :: Sig -> Sig -> Sig -> Sig
ladder kcf res asig = moogladder asig kcf res
plastic :: Sig -> Sig -> Sig -> Sig
plastic kcf res asig = rezzy asig kcf (1 + 99 * res)
wobble :: Sig -> Sig -> Sig -> Sig
wobble kcf res asig = lowres asig kcf res
trumpy :: Sig -> Sig -> Sig -> Sig
trumpy kcf res asig = vlowres asig kcf (res* 0.15) 6 (4 + res * 20)
harsh :: Sig -> Sig -> Sig -> Sig
harsh kcf res asig = bat (\x -> bqrez x kcf (1 + 90 * res)) asig
tbf :: Sig -> Sig -> Sig -> Sig -> Sig
tbf dist kcf res asig = tbvcf asig (1010 + kcf) res (0.5 + 3.5 * dist) 0.5
slp :: Sig -> Sig -> Sig -> Sig
slp kcf res asig = lows
where (_, lows, _, _) = statevar asig kcf res
shp :: Sig -> Sig -> Sig -> Sig
shp kcf res asig = highs
where (highs, _, _, _) = statevar asig kcf res
sbp :: Sig -> Sig -> Sig -> Sig
sbp kcf res asig = mids
where (_, _, mids, _) = statevar asig kcf res
sbr :: Sig -> Sig -> Sig -> Sig
sbr kcf res asig = sides
where (_, _, _, sides) = statevar asig kcf res
multiStatevar :: (Sig, Sig, Sig) -> Sig -> Sig -> Sig -> Sig
multiStatevar (weightLows, wieghtHighs, weightMids) kcf res asig = weightLows * lows + wieghtHighs * highs + weightMids * mids
where (highs, lows, mids, _) = statevar asig kcf res
multiSvfilter :: (Sig, Sig, Sig) -> Sig -> Sig -> Sig -> Sig
multiSvfilter (weightLows, wieghtHighs, weightMids) kcf res asig = weightLows * lows + wieghtHighs * highs + weightMids * mids
where (highs, lows, mids) = svfilter asig kcf res