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,
zdf1, zlp1, zhp1, zap1,
zdf2, zlp, zhp, zbp, zubp, zbr, zap, zpeak,
zladder,
lpCheb1, lpCheb1', lpCheb2, lpCheb2', clp, clp',
hpCheb1, hpCheb1', hpCheb2, hpCheb2', chp, chp',
plastic, wobble, trumpy, harsh,
tbf, diode, fdiode, linDiode,
linKorg_lp, linKorg_hp, linKorg_bp, korg_lp, korg_hp, korg_bp,
klp, khp, kbp,
slp, shp, sbp, sbr,
multiStatevar, multiSvfilter
) where
import Control.Applicative
import Csound.Typed
import Csound.Typed.Plugins hiding (
zdf1, zlp1, zhp1, zap1,
zdf2, zlp, zbp, zhp, zdf2_notch, zbr,
zladder,
diode, linDiode, noNormDiode,
linKorg_lp, linKorg_hp, korg_lp, korg_hp)
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, Sig, Sig, Sig)
alp4 freq reson asig = mvclpf4 asig freq reson
ahp :: Sig -> Sig -> Sig
ahp freq asig = mvchpf asig freq
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
zdf1 :: Sig -> Sig -> (Sig, Sig)
zdf1 cfq asig = zdf_1pole_mode asig cfq
zlp1 :: Sig -> Sig -> Sig
zlp1 cfq asig = zdf_1pole asig cfq `withSig` 0
zhp1 :: Sig -> Sig -> Sig
zhp1 cfq asig = zdf_1pole asig cfq `withSig` 1
zap1 :: Sig -> Sig -> Sig
zap1 cfq asig = zdf_1pole asig cfq `withSig` 2
zdf2 :: Sig -> Sig -> Sig -> (Sig, Sig, Sig)
zdf2 cfq q asig = zdf_2pole_mode asig cfq (uon 0.5 25 q)
zpole2 :: Sig -> Sig -> Sig -> Sig -> Sig
zpole2 n cfq q asig = zdf_2pole asig cfq (uon 0.5 25 q) `withSig` n
zlp :: Sig -> Sig -> Sig -> Sig
zlp = zpole2 0
zhp :: Sig -> Sig -> Sig -> Sig
zhp = zpole2 1
zbp :: Sig -> Sig -> Sig -> Sig
zbp = zpole2 2
zubp :: Sig -> Sig -> Sig -> Sig
zubp = zpole2 3
zbr :: Sig -> Sig -> Sig -> Sig
zbr = zpole2 4
zap :: Sig -> Sig -> Sig -> Sig
zap = zpole2 5
zpeak :: Sig -> Sig -> Sig -> Sig
zpeak = zpole2 6
zladder :: Sig -> Sig -> Sig -> Sig
zladder cfq q asig = zdf_ladder asig cfq (uon 0.5 25 q)
diode :: D -> Sig -> Sig -> Sig -> Sig
diode isaturation cfq fbk asig = diode_ladder asig cfq (17 * fbk) `withDs` [1, isaturation]
fdiode :: D -> Sig -> Sig -> Sig -> Sig
fdiode isaturation cfq fbk asig = diode_ladder asig cfq (17 * fbk) `withDs` [2, isaturation]
linDiode :: Sig -> Sig -> Sig -> Sig
linDiode cfq fbk asig = diode_ladder asig cfq (17 * fbk) `withDs` [0]
korg_lp :: D -> Sig -> Sig -> Sig -> Sig
korg_lp isaturation cfq q asig = k35_lpf asig cfq (uon 1 10 q) `withDs` [1, isaturation]
korg_hp :: D -> Sig -> Sig -> Sig -> Sig
korg_hp isaturation cfq q asig = k35_hpf asig cfq (uon 1 10 q) `withDs` [1, isaturation]
korg_bp :: D -> Sig -> Sig -> Sig -> Sig
korg_bp isaturation cfq q asig = korg_hp isaturation cfq q $ korg_lp isaturation cfq q asig
linKorg_lp :: Sig -> Sig -> Sig -> Sig
linKorg_lp cfq q asig = k35_lpf asig cfq (uon 1 10 q) `withDs` [0]
linKorg_hp :: Sig -> Sig -> Sig -> Sig
linKorg_hp cfq q asig = k35_hpf asig cfq (uon 1 10 q) `withDs` [0]
linKorg_bp :: Sig -> Sig -> Sig -> Sig
linKorg_bp cfq q asig = linKorg_hp cfq q $ linKorg_lp cfq q asig
klp :: D -> Sig -> Sig -> Sig -> Sig
klp = korg_lp
khp :: D -> Sig -> Sig -> Sig -> Sig
khp = korg_hp
kbp :: D -> Sig -> Sig -> Sig -> Sig
kbp = korg_bp