-- | Specialized Filters module CsoundExpr.Opcodes.Sigmod.Speciali (dcblock, dcblock2, pareq, rbjeq, eqfil, nlfilt, filter2A, filter2K, fofilter, hilbert, zfilter2) where import CsoundExpr.Base.Types import CsoundExpr.Base.MultiOut import CsoundExpr.Base.SideEffect import CsoundExpr.Base.UserDefined -- | * opcode : dcblock -- -- -- * syntax : -- -- > ares dcblock ain [, igain] -- -- -- * description : -- -- Implements the DC blocking filter -- -- -- * url : dcblock :: [Irate] -> Arate -> Arate dcblock i0init a1in = opcode "dcblock" args where args = [to a1in] ++ map to i0init -- | * opcode : dcblock2 -- -- -- * syntax : -- -- > ares dcblock2 ain [, iorder] [, iskip] -- -- -- * description : -- -- Implements a DC blocking filter with improved DC attenuation. -- -- -- * url : dcblock2 :: [Irate] -> Arate -> Arate dcblock2 i0init a1in = opcode "dcblock2" args where args = [to a1in] ++ map to i0init -- | * opcode : pareq -- -- -- * syntax : -- -- > ares pareq asig, kc, kv, kq [, imode] [, iskip] -- -- -- * description : -- -- Implementation of Zoelzer's parametric equalizer filters, with -- some modifications by the author. -- -- -- * url : pareq :: (K k0, K k1, K k2) => [Irate] -> Arate -> k0 -> k1 -> k2 -> Arate pareq i0init a1sig k2c k3v k4q = opcode "pareq" args where args = [to a1sig, to k2c, to k3v, to k4q] ++ map to i0init -- | * opcode : rbjeq -- -- -- * syntax : -- -- > ar rbjeq asig, kfco, klvl, kQ, kS[, imode] -- -- -- * description : -- -- Parametric equalizer and filter opcode with 7 filter types, -- based on algorithm by Robert Bristow-Johnson. -- -- -- * url : rbjeq :: (K k0, K k1, K k2, K k3) => [Irate] -> Arate -> k0 -> k1 -> k2 -> k3 -> Arate rbjeq i0init a1sig k2fco k3lvl k4Q k5S = opcode "rbjeq" args where args = [to a1sig, to k2fco, to k3lvl, to k4Q, to k5S] ++ map to i0init -- | * opcode : eqfil -- -- -- * syntax : -- -- > asig eqfil ain, kcf, kbw, kgain[, istor] -- -- -- * description : -- -- The opcode eqfil is a 2nd order tunable equalisation filter -- based on Regalia and Mitra design ("Tunable Digital Frequency -- Response Equalization Filters", IEEE Trans. on Ac., Sp. and Sig -- Proc., 35 (1), 1987). It provides a peak/notch filter for -- building parametric/graphic equalisers. -- -- -- * url : eqfil :: (K k0, K k1, K k2) => [Irate] -> Arate -> k0 -> k1 -> k2 -> Arate eqfil i0init a1in k2cf k3bw k4gain = opcode "eqfil" args where args = [to a1in, to k2cf, to k3bw, to k4gain] ++ map to i0init -- | * opcode : nlfilt -- -- -- * syntax : -- -- > ares nlfilt ain, ka, kb, kd, kC, kL -- -- -- * description : -- -- Implements the filter: -- -- -- * url : nlfilt :: (K k0, K k1, K k2, K k3, K k4) => Arate -> k0 -> k1 -> k2 -> k3 -> k4 -> Arate nlfilt a0in k1a k2b k3d k4C k5L = opcode "nlfilt" args where args = [to a0in, to k1a, to k2b, to k3d, to k4C, to k5L] -- | * opcode : filter2 -- -- -- * syntax : -- -- > ares filter2 asig, iM, iN, ib0, ib1,..., ibM, ia1, ia2,..., iaN -- > kres filter2 ksig, iM, iN, ib0, ib1,..., ibM, ia1, ia2,..., iaN -- -- -- * description : -- -- General purpose custom filter with time-varying pole control. -- The filter coefficients implement the following difference -- equation: -- -- -- * url : filter2A :: Arate -> Irate -> Irate -> [Irate] -> [Irate] -> Arate filter2A a0sig i1m i2n i3bs i4as = opcode "filter2" args where args = [to a0sig, to i1m, to i2n] ++ map to i3bs ++ map to i4as -- | * opcode : filter2 -- -- -- * syntax : -- -- > ares filter2 asig, iM, iN, ib0, ib1,..., ibM, ia1, ia2,..., iaN -- > kres filter2 ksig, iM, iN, ib0, ib1,..., ibM, ia1, ia2,..., iaN -- -- -- * description : -- -- General purpose custom filter with time-varying pole control. -- The filter coefficients implement the following difference -- equation: -- -- -- * url : filter2K :: (K k0) => k0 -> Irate -> Irate -> [Irate] -> [Irate] -> Krate filter2K k0sig i1m i2n i3bs i4as = opcode "filter2" args where args = [to k0sig, to i1m, to i2n] ++ map to i3bs ++ map to i4as -- | * opcode : fofilter -- -- -- * syntax : -- -- > asig fofilter ain, kcf, kris, kdec[, istor] -- -- -- * description : -- -- Fofilter generates a stream of overlapping sinewave grains, when -- fed with a pulse train. Each grain is the impulse response of a -- combination of two BP filters. The grains are defined by their -- attack time (determining the skirtwidth of the formant region at -- -60dB) and decay time (-6dB bandwidth). Overlapping will occur -- when 1/freq < decay, but, unlike FOF, there is no upper limit on -- the number of overlaps. The original idea for this opcode came -- from J McCartney's formlet class in SuperCollider, but this is -- possibly implemented differently(?). -- -- -- * url : fofilter :: (K k0, K k1, K k2) => [Irate] -> Arate -> k0 -> k1 -> k2 -> Arate fofilter i0init a1in k2cf k3ris k4dec = opcode "fofilter" args where args = [to a1in, to k2cf, to k3ris, to k4dec] ++ map to i0init -- | * opcode : hilbert -- -- -- * syntax : -- -- > ar1, ar2 hilbert asig -- -- -- * description : -- -- An IIR implementation of a Hilbert transformer. -- -- -- * url : hilbert :: Arate -> MultiOut hilbert a0sig = opcode "hilbert" args where args = [to a0sig] -- | * opcode : zfilter2 -- -- -- * syntax : -- -- > ares zfilter2 asig, kdamp, kfreq, iM, iN, ib0, ib1,..., ibM, -- > ia1,ia2,..., iaN -- -- -- * description : -- -- General purpose custom filter with time-varying pole control. -- The filter coefficients implement the following difference -- equation: -- -- -- * url : zfilter2 :: (K k0, K k1) => Arate -> k0 -> k1 -> Irate -> Irate -> [Irate] -> [Irate] -> Arate zfilter2 a0sig k1damp k2freq i3m i4n i5bs i6as = opcode "filter2" args where args = [to a0sig, to k1damp, to k2freq, to i3m, to i4n] ++ map to i5bs ++ map to i6as