-- | Standard Filters
module CsoundExpr.Opcodes.Sigmod.Standard
    (areson,
     lowpass2,
     lowres,
     lowresx,
     lpf18,
     moogvcf,
     moogladder,
     reson,
     resonr,
     resonx,
     resony,
     resonz,
     rezzy,
     statevar,
     svfilter,
     tbvcf,
     vlowres,
     bqrez,
     atone,
     atonex,
     tone,
     tonex,
     biquad,
     biquada,
     butterbp,
     butterbr,
     butterhp,
     butterlp,
     butbp,
     butbr,
     buthp,
     butlp,
     clfilt,
     aresonk,
     atonek,
     lineto,
     port,
     portk,
     resonk,
     resonxk,
     tlineto,
     tonek)
where



import CsoundExpr.Base.Types
import CsoundExpr.Base.MultiOut
import CsoundExpr.Base.SideEffect
import CsoundExpr.Base.UserDefined



-- | * opcode : areson
--  
--  
-- * syntax : 
--  
--  >   ares areson asig, kcf, kbw [, iscl] [, iskip]
--  
--  
-- * description : 
--  
--  A notch filter whose transfer functions are the complements of
-- the reson opcode.
--  
--  
-- * url : <http://www.csounds.com/manual/html/areson.html>
 
areson :: (K k0, K k1) => [Irate] -> Arate -> k0 -> k1 -> Arate
areson i0init a1sig k2cf k3bw = opcode "areson" args
  where args = [to a1sig, to k2cf, to k3bw] ++ map to i0init


-- | * opcode : lowpass2
--  
--  
-- * syntax : 
--  
--  >   ares lowpass2 asig, kcf, kq [, iskip]
--  
--  
-- * description : 
--  
--  Implementation of a resonant second-order lowpass filter.
--  
--  
-- * url : <http://www.csounds.com/manual/html/lowpass2.html>
 
lowpass2 :: (K k0, K k1) => [Irate] -> Arate -> k0 -> k1 -> Arate
lowpass2 i0init a1sig k2cf k3q = opcode "lowpass2" args
  where args = [to a1sig, to k2cf, to k3q] ++ map to i0init


-- | * opcode : lowres
--  
--  
-- * syntax : 
--  
--  >   ares lowres asig, kcutoff, kresonance [, iskip]
--  
--  
-- * description : 
--  
--  lowres is a resonant lowpass filter.
--  
--  
-- * url : <http://www.csounds.com/manual/html/lowres.html>
 
lowres :: (K k0, K k1) => [Irate] -> Arate -> k0 -> k1 -> Arate
lowres i0init a1sig k2cutoff k3resonance = opcode "lowres" args
  where args
          = [to a1sig, to k2cutoff, to k3resonance] ++ map to i0init


-- | * opcode : lowresx
--  
--  
-- * syntax : 
--  
--  >   ares lowresx asig, kcutoff, kresonance [, inumlayer] [, iskip]
--  
--  
-- * description : 
--  
--  lowresx is equivalent to more layers of lowres with the same
-- arguments serially connected.
--  
--  
-- * url : <http://www.csounds.com/manual/html/lowresx.html>
 
lowresx :: (K k0, K k1) => [Irate] -> Arate -> k0 -> k1 -> Arate
lowresx i0init a1sig k2cutoff k3resonance = opcode "lowresx" args
  where args
          = [to a1sig, to k2cutoff, to k3resonance] ++ map to i0init


-- | * opcode : lpf18
--  
--  
-- * syntax : 
--  
--  >   ares lpf18 asig, kfco, kres, kdist
--  
--  
-- * description : 
--  
--  Implementation of a 3 pole sweepable resonant lowpass filter.
--  
--  
-- * url : <http://www.csounds.com/manual/html/lpf18.html>
 
lpf18 :: (K k0, K k1, K k2) => Arate -> k0 -> k1 -> k2 -> Arate
lpf18 a0sig k1fco k2res k3dist = opcode "lpf18" args
  where args = [to a0sig, to k1fco, to k2res, to k3dist]


-- | * opcode : moogvcf
--  
--  
-- * syntax : 
--  
--  >   ares moogvcf asig, xfco, xres [,iscale, iskip]
--  
--  
-- * description : 
--  
--  A digital emulation of the Moog diode ladder filter
-- configuration.
--  
--  
-- * url : <http://www.csounds.com/manual/html/moogvcf.html>
 
moogvcf :: (X x0, X x1) => [Irate] -> Arate -> x0 -> x1 -> Arate
moogvcf i0init a1sig x2fco x3res = opcode "moogvcf" args
  where args = [to a1sig, to x2fco, to x3res] ++ map to i0init


-- | * opcode : moogladder
--  
--  
-- * syntax : 
--  
--  >   asig moogladder ain, kcf, kres[, istor]
--  
--  
-- * description : 
--  
--  Moogladder is an new digital implementation of the Moog ladder
-- filter based on the work of Antti Huovilainen, described in the
-- paper "Non-Linear Digital Implementation of the Moog Ladder
-- Filter" (Proceedings of DaFX04, Univ of Napoli). This
-- implementation is probably a more accurate digital representation
-- of the original analogue filter.
--  
--  
-- * url : <http://www.csounds.com/manual/html/moogladder.html>
 
moogladder :: (K k0, K k1) => [Irate] -> Arate -> k0 -> k1 -> Arate
moogladder i0init a1in k2cf k3res = opcode "moogladder" args
  where args = [to a1in, to k2cf, to k3res] ++ map to i0init


-- | * opcode : reson
--  
--  
-- * syntax : 
--  
--  >   ares reson asig, kcf, kbw [, iscl] [, iskip]
--  
--  
-- * description : 
--  
--  A second-order resonant filter.
--  
--  
-- * url : <http://www.csounds.com/manual/html/reson.html>
 
reson :: (K k0, K k1) => [Irate] -> Arate -> k0 -> k1 -> Arate
reson i0init a1sig k2cf k3bw = opcode "reson" args
  where args = [to a1sig, to k2cf, to k3bw] ++ map to i0init


-- | * opcode : resonr
--  
--  
-- * syntax : 
--  
--  >   ares resonr asig, kcf, kbw [, iscl] [, iskip]
--  
--  
-- * description : 
--  
--  Implementations of a second-order, two-pole two-zero bandpass
-- filter with variable frequency response.
--  
--  
-- * url : <http://www.csounds.com/manual/html/resonr.html>
 
resonr :: (K k0, K k1) => [Irate] -> Arate -> k0 -> k1 -> Arate
resonr i0init a1sig k2cf k3bw = opcode "resonr" args
  where args = [to a1sig, to k2cf, to k3bw] ++ map to i0init


-- | * opcode : resonx
--  
--  
-- * syntax : 
--  
--  >   ares resonx asig, kcf, kbw [, inumlayer] [, iscl] [, iskip]
--  
--  
-- * description : 
--  
--  resonx is equivalent to a filters consisting of more layers of
-- reson with the same arguments, serially connected. Using a stack
-- of a larger number of filters allows a sharper cutoff. They are
-- faster than using a larger number instances in a Csound orchestra
-- of the old opcodes, because only one initialization and k- cycle
-- are needed at time and the audio loop falls entirely inside the
-- cache memory of processor.
--  
--  
-- * url : <http://www.csounds.com/manual/html/resonx.html>
 
resonx :: (K k0, K k1) => [Irate] -> Arate -> k0 -> k1 -> Arate
resonx i0init a1sig k2cf k3bw = opcode "resonx" args
  where args = [to a1sig, to k2cf, to k3bw] ++ map to i0init


-- | * opcode : resony
--  
--  
-- * syntax : 
--  
--  >   ares resony asig, kbf, kbw, inum, ksep [, isepmode] [, iscl] [, iskip]
--  
--  
-- * description : 
--  
--  A bank of second-order bandpass filters, connected in parallel.
--  
--  
-- * url : <http://www.csounds.com/manual/html/resony.html>
 
resony ::
         (K k0, K k1, K k2) =>
         [Irate] -> Arate -> k0 -> k1 -> Irate -> k2 -> Arate
resony i0init a1sig k2bf k3bw i4num k5sep = opcode "resony" args
  where args
          = [to a1sig, to k2bf, to k3bw, to i4num, to k5sep] ++ map to i0init


-- | * opcode : resonz
--  
--  
-- * syntax : 
--  
--  >   ares resonz asig, kcf, kbw [, iscl] [, iskip]
--  
--  
-- * description : 
--  
--  Implementations of a second-order, two-pole two-zero bandpass
-- filter with variable frequency response.
--  
--  
-- * url : <http://www.csounds.com/manual/html/resonz.html>
 
resonz :: (K k0, K k1) => [Irate] -> Arate -> k0 -> k1 -> Arate
resonz i0init a1sig k2cf k3bw = opcode "resonz" args
  where args = [to a1sig, to k2cf, to k3bw] ++ map to i0init


-- | * opcode : rezzy
--  
--  
-- * syntax : 
--  
--  >   ares rezzy asig, xfco, xres [, imode, iskip]
--  
--  
-- * description : 
--  
--  A resonant low-pass filter.
--  
--  
-- * url : <http://www.csounds.com/manual/html/rezzy.html>
 
rezzy :: (X x0, X x1) => [Irate] -> Arate -> x0 -> x1 -> Arate
rezzy i0init a1sig x2fco x3res = opcode "rezzy" args
  where args = [to a1sig, to x2fco, to x3res] ++ map to i0init


-- | * opcode : statevar
--  
--  
-- * syntax : 
--  
--  >   ahp,alp,abp,abr statevar ain, kcf, kq [, iosamps, istor]
--  
--  
-- * description : 
--  
--  Statevar is a new digital implementation of the analogue
-- state-variable filter. This filter has four simultaneous outputs:
-- high-pass, low-pass, band-pass and band-reject. This filter uses
-- oversampling for sharper resonance (default: 3 times
-- oversampling). It includes a resonance limiter that prevents the
-- filter from getting unstable.
--  
--  
-- * url : <http://www.csounds.com/manual/html/statevar.html>
 
statevar ::
           (K k0, K k1) => [Irate] -> Arate -> k0 -> k1 -> MultiOut
statevar i0init a1in k2cf k3q = opcode "statevar" args
  where args = [to a1in, to k2cf, to k3q] ++ map to i0init


-- | * opcode : svfilter
--  
--  
-- * syntax : 
--  
--  >   alow, ahigh, aband svfilter asig, kcf, kq [, iscl]
--  
--  
-- * description : 
--  
--  Implementation of a resonant second order filter, with
-- simultaneous lowpass, highpass and bandpass outputs.
--  
--  
-- * url : <http://www.csounds.com/manual/html/svfilter.html>
 
svfilter ::
           (K k0, K k1) => [Irate] -> Arate -> k0 -> k1 -> MultiOut
svfilter i0init a1sig k2cf k3q = opcode "svfilter" args
  where args = [to a1sig, to k2cf, to k3q] ++ map to i0init


-- | * opcode : tbvcf
--  
--  
-- * syntax : 
--  
--  >   ares tbvcf asig, xfco, xres, kdist, kasym [, iskip]
--  
--  
-- * description : 
--  
--  This opcode attempts to model some of the filter characteristics
-- of a Roland TB303 voltage-controlled filter. Euler's method is
-- used to approximate the system, rather than traditional filter
-- methods. Cutoff frequency, Q, and distortion are all coupled.
-- Empirical methods were used to try to unentwine, but frequency is
-- only approximate as a result. Future fixes for some problems with
-- this opcode may break existing orchestras relying on this version
-- of tbvcf.
--  
--  
-- * url : <http://www.csounds.com/manual/html/tbvcf.html>
 
tbvcf ::
        (X x0, X x1, K k0, K k1) =>
        [Irate] -> Arate -> x0 -> x1 -> k0 -> k1 -> Arate
tbvcf i0init a1sig x2fco x3res k4dist k5asym = opcode "tbvcf" args
  where args
          = [to a1sig, to x2fco, to x3res, to k4dist, to k5asym] ++
              map to i0init


-- | * opcode : vlowres
--  
--  
-- * syntax : 
--  
--  >   ares vlowres asig, kfco, kres, iord, ksep
--  
--  
-- * description : 
--  
--  A bank of filters in which the cutoff frequency can be separated
-- under user control
--  
--  
-- * url : <http://www.csounds.com/manual/html/vlowres.html>
 
vlowres ::
          (K k0, K k1, K k2) => Arate -> k0 -> k1 -> Irate -> k2 -> Arate
vlowres a0sig k1fco k2res i3ord k4sep = opcode "vlowres" args
  where args = [to a0sig, to k1fco, to k2res, to i3ord, to k4sep]


-- | * opcode : bqrez
--  
--  
-- * syntax : 
--  
--  >   ares bqrez asig, xfco, xres [, imode] [, iskip]
--  
--  
-- * description : 
--  
--  A second-order multi-mode filter.
--  
--  
-- * url : <http://www.csounds.com/manual/html/bqrez.html>
 
bqrez :: (X x0, X x1) => [Irate] -> Arate -> x0 -> x1 -> Arate
bqrez i0init a1sig x2fco x3res = opcode "bqrez" args
  where args = [to a1sig, to x2fco, to x3res] ++ map to i0init


-- | * opcode : atone
--  
--  
-- * syntax : 
--  
--  >   ares atone asig, khp [, iskip]
--  
--  
-- * description : 
--  
--  A hi-pass filter whose transfer functions are the complements of
-- the tone opcode.
--  
--  
-- * url : <http://www.csounds.com/manual/html/atone.html>
 
atone :: (K k0) => [Irate] -> Arate -> k0 -> Arate
atone i0init a1sig k2hp = opcode "atone" args
  where args = [to a1sig, to k2hp] ++ map to i0init


-- | * opcode : atonex
--  
--  
-- * syntax : 
--  
--  >   ares atonex asig, khp [, inumlayer] [, iskip]
--  
--  
-- * description : 
--  
--  atonex is equivalent to a filter consisting of more layers of
-- atone with the same arguments, serially connected. Using a stack
-- of a larger number of filters allows a sharper cutoff. They are
-- faster than using a larger number instances in a Csound orchestra
-- of the old opcodes, because only one initialization and k- cycle
-- are needed at time and the audio loop falls entirely inside the
-- cache memory of processor.
--  
--  
-- * url : <http://www.csounds.com/manual/html/atonex.html>
 
atonex :: (K k0) => [Irate] -> Arate -> k0 -> Arate
atonex i0init a1sig k2hp = opcode "atonex" args
  where args = [to a1sig, to k2hp] ++ map to i0init


-- | * opcode : tone
--  
--  
-- * syntax : 
--  
--  >   ares tone asig, khp [, iskip]
--  
--  
-- * description : 
--  
--  A first-order recursive low-pass filter with variable frequency
-- response.
--  
--  
-- * url : <http://www.csounds.com/manual/html/tone.html>
 
tone :: (K k0) => [Irate] -> Arate -> k0 -> Arate
tone i0init a1sig k2hp = opcode "tone" args
  where args = [to a1sig, to k2hp] ++ map to i0init


-- | * opcode : tonex
--  
--  
-- * syntax : 
--  
--  >   ares tonex asig, khp [, inumlayer] [, iskip]
--  
--  
-- * description : 
--  
--  tonex is equivalent to a filter consisting of more layers of
-- tone with the same arguments, serially connected. Using a stack
-- of a larger number of filters allows a sharper cutoff. They are
-- faster than using a larger number instances in a Csound orchestra
-- of the old opcodes, because only one initialization and k- cycle
-- are needed at time and the audio loop falls entirely inside the
-- cache memory of processor.
--  
--  
-- * url : <http://www.csounds.com/manual/html/tonex.html>
 
tonex :: (K k0) => [Irate] -> Arate -> k0 -> Arate
tonex i0init a1sig k2hp = opcode "tonex" args
  where args = [to a1sig, to k2hp] ++ map to i0init


-- | * opcode : biquad
--  
--  
-- * syntax : 
--  
--  >   ares biquad asig, kb0, kb1, kb2, ka0, ka1, ka2 [, iskip]
--  
--  
-- * description : 
--  
--  A sweepable general purpose biquadratic digital filter.
--  
--  
-- * url : <http://www.csounds.com/manual/html/biquad.html>
 
biquad ::
         (K k0, K k1, K k2, K k3, K k4, K k5) =>
         [Irate] -> Arate -> k0 -> k1 -> k2 -> k3 -> k4 -> k5 -> Arate
biquad i0init a1sig k2b0 k3b1 k4b2 k5a0 k6a1 k7a2
  = opcode "biquad" args
  where args
          = [to a1sig, to k2b0, to k3b1, to k4b2, to k5a0, to k6a1, to k7a2]
              ++ map to i0init


-- | * opcode : biquada
--  
--  
-- * syntax : 
--  
--  >   ares biquada asig, ab0, ab1, ab2, aa0, aa1, aa2 [, iskip]
--  
--  
-- * description : 
--  
--  A sweepable general purpose biquadratic digital filter.
--  
--  
-- * url : <http://www.csounds.com/manual/html/biquada.html>
 
biquada ::
          [Irate] ->
            Arate ->
              Arate -> Arate -> Arate -> Arate -> Arate -> Arate -> Arate
biquada i0init a1sig a2b0 a3b1 a4b2 a5a0 a6a1 a7a2
  = opcode "biquada" args
  where args
          = [to a1sig, to a2b0, to a3b1, to a4b2, to a5a0, to a6a1, to a7a2]
              ++ map to i0init


-- | * opcode : butterbp
--  
--  
-- * syntax : 
--  
--  >   ares butterbp asig, kfreq, kband [, iskip]
--  
--  
-- * description : 
--  
--  Implementation of a second-order band-pass Butterworth filter.
-- This opcode can also be written as butbp.
--  
--  
-- * url : <http://www.csounds.com/manual/html/butterbp.html>
 
butterbp :: (K k0, K k1) => [Irate] -> Arate -> k0 -> k1 -> Arate
butterbp i0init a1sig k2freq k3band = opcode "butterbp" args
  where args = [to a1sig, to k2freq, to k3band] ++ map to i0init


-- | * opcode : butterbr
--  
--  
-- * syntax : 
--  
--  >   ares butterbr asig, kfreq, kband [, iskip]
--  
--  
-- * description : 
--  
--  Implementation of a second-order band-reject Butterworth filter.
-- This opcode can also be written as butbr.
--  
--  
-- * url : <http://www.csounds.com/manual/html/butterbr.html>
 
butterbr :: (K k0, K k1) => [Irate] -> Arate -> k0 -> k1 -> Arate
butterbr i0init a1sig k2freq k3band = opcode "butterbr" args
  where args = [to a1sig, to k2freq, to k3band] ++ map to i0init


-- | * opcode : butterhp
--  
--  
-- * syntax : 
--  
--  >   ares butterhp asig, kfreq [, iskip]
--  
--  
-- * description : 
--  
--  Implementation of second-order high-pass Butterworth filter.
-- This opcode can also be written as buthp.
--  
--  
-- * url : <http://www.csounds.com/manual/html/butterhp.html>
 
butterhp :: (K k0) => [Irate] -> Arate -> k0 -> Arate
butterhp i0init a1sig k2freq = opcode "butterhp" args
  where args = [to a1sig, to k2freq] ++ map to i0init


-- | * opcode : butterlp
--  
--  
-- * syntax : 
--  
--  >   ares butterlp asig, kfreq [, iskip]
--  
--  
-- * description : 
--  
--  Implementation of a second-order low-pass Butterworth filter.
-- This opcode can also be written as butlp.
--  
--  
-- * url : <http://www.csounds.com/manual/html/butterlp.html>
 
butterlp :: (K k0) => [Irate] -> Arate -> k0 -> Arate
butterlp i0init a1sig k2freq = opcode "butterlp" args
  where args = [to a1sig, to k2freq] ++ map to i0init


-- | * opcode : butbp
--  
--  
-- * syntax : 
--  
--  >   ares butbp asig, kfreq, kband [, iskip]
--  
--  
-- * description : 
--  
--  Same as the butterbp opcode.
--  
--  
-- * url : <http://www.csounds.com/manual/html/butbp.html>
 
butbp :: (K k0, K k1) => [Irate] -> Arate -> k0 -> k1 -> Arate
butbp i0init a1sig k2freq k3band = opcode "butbp" args
  where args = [to a1sig, to k2freq, to k3band] ++ map to i0init


-- | * opcode : butbr
--  
--  
-- * syntax : 
--  
--  >   ares butbr asig, kfreq, kband [, iskip]
--  
--  
-- * description : 
--  
--  Same as the butterbr opcode.
--  
--  
-- * url : <http://www.csounds.com/manual/html/butbr.html>
 
butbr :: (K k0, K k1) => [Irate] -> Arate -> k0 -> k1 -> Arate
butbr i0init a1sig k2freq k3band = opcode "butbr" args
  where args = [to a1sig, to k2freq, to k3band] ++ map to i0init


-- | * opcode : buthp
--  
--  
-- * syntax : 
--  
--  >   ares buthp asig, kfreq [, iskip]
--  
--  
-- * description : 
--  
--  Same as the butterhp opcode.
--  
--  
-- * url : <http://www.csounds.com/manual/html/buthp.html>
 
buthp :: (K k0) => [Irate] -> Arate -> k0 -> Arate
buthp i0init a1sig k2freq = opcode "buthp" args
  where args = [to a1sig, to k2freq] ++ map to i0init


-- | * opcode : butlp
--  
--  
-- * syntax : 
--  
--  >   ares butlp asig, kfreq [, iskip]
--  
--  
-- * description : 
--  
--  Same as the butterlp opcode.
--  
--  
-- * url : <http://www.csounds.com/manual/html/butlp.html>
 
butlp :: (K k0) => [Irate] -> Arate -> k0 -> Arate
butlp i0init a1sig k2freq = opcode "butlp" args
  where args = [to a1sig, to k2freq] ++ map to i0init


-- | * opcode : clfilt
--  
--  
-- * syntax : 
--  
--  >   ares clfilt asig, kfreq, itype, inpol [, ikind] [, ipbr] [, isba] [, iskip]
--  
--  
-- * description : 
--  
--  Implements the classical standard analog filter types: low-pass
-- and high-pass. They are implemented with the four classical kinds
-- of filters: Butterworth, Chebyshev Type I, Chebyshev Type II, and
-- Elliptical. The number of poles may be any even number from 2 to
-- 80.
--  
--  
-- * url : <http://www.csounds.com/manual/html/clfilt.html>
 
clfilt ::
         (K k0) => [Irate] -> Arate -> k0 -> Irate -> Irate -> Arate
clfilt i0init a1sig k2freq i3type i4npol = opcode "clfilt" args
  where args
          = [to a1sig, to k2freq, to i3type, to i4npol] ++ map to i0init


-- | * opcode : aresonk
--  
--  
-- * syntax : 
--  
--  >   kres aresonk ksig, kcf, kbw [, iscl] [, iskip]
--  
--  
-- * description : 
--  
--  A notch filter whose transfer functions are the complements of
-- the reson opcode.
--  
--  
-- * url : <http://www.csounds.com/manual/html/aresonk.html>
 
aresonk :: (K k0, K k1, K k2) => [Irate] -> k0 -> k1 -> k2 -> Krate
aresonk i0init k1sig k2cf k3bw = opcode "aresonk" args
  where args = [to k1sig, to k2cf, to k3bw] ++ map to i0init


-- | * opcode : atonek
--  
--  
-- * syntax : 
--  
--  >   kres atonek ksig, khp [, iskip]
--  
--  
-- * description : 
--  
--  A hi-pass filter whose transfer functions are the complements of
-- the tonek opcode.
--  
--  
-- * url : <http://www.csounds.com/manual/html/atonek.html>
 
atonek :: (K k0, K k1) => [Irate] -> k0 -> k1 -> Krate
atonek i0init k1sig k2hp = opcode "atonek" args
  where args = [to k1sig, to k2hp] ++ map to i0init


-- | * opcode : lineto
--  
--  
-- * syntax : 
--  
--  >   kres lineto ksig, ktime
--  
--  
-- * description : 
--  
--  Generate glissandos starting from a control signal.
--  
--  
-- * url : <http://www.csounds.com/manual/html/lineto.html>
 
lineto :: (K k0, K k1) => k0 -> k1 -> Krate
lineto k0sig k1time = opcode "lineto" args
  where args = [to k0sig, to k1time]


-- | * opcode : port
--  
--  
-- * syntax : 
--  
--  >   kres port ksig, ihtim [, isig]
--  
--  
-- * description : 
--  
--  Applies portamento to a step-valued control signal.
--  
--  
-- * url : <http://www.csounds.com/manual/html/port.html>
 
port :: (K k0) => [Irate] -> k0 -> Irate -> Krate
port i0init k1sig i2htim = opcode "port" args
  where args = [to k1sig, to i2htim] ++ map to i0init


-- | * opcode : portk
--  
--  
-- * syntax : 
--  
--  >   kres portk ksig, khtim [, isig]
--  
--  
-- * description : 
--  
--  Applies portamento to a step-valued control signal.
--  
--  
-- * url : <http://www.csounds.com/manual/html/portk.html>
 
portk :: (K k0, K k1) => [Irate] -> k0 -> k1 -> Krate
portk i0init k1sig k2htim = opcode "portk" args
  where args = [to k1sig, to k2htim] ++ map to i0init


-- | * opcode : resonk
--  
--  
-- * syntax : 
--  
--  >   kres resonk ksig, kcf, kbw [, iscl] [, iskip]
--  
--  
-- * description : 
--  
--  A second-order resonant filter.
--  
--  
-- * url : <http://www.csounds.com/manual/html/resonk.html>
 
resonk :: (K k0, K k1, K k2) => [Irate] -> k0 -> k1 -> k2 -> Krate
resonk i0init k1sig k2cf k3bw = opcode "resonk" args
  where args = [to k1sig, to k2cf, to k3bw] ++ map to i0init


-- | * opcode : resonxk
--  
--  
-- * syntax : 
--  
--  >   kres resonxk ksig, kcf, kbw[, inumlayer, iscl, istor]
--  
--  
-- * description : 
--  
--  resonxk is equivalent to a group of resonk filters, with the
-- same arguments, serially connected. Using a stack of a larger
-- number of filters allows a sharper cutoff.
--  
--  
-- * url : <http://www.csounds.com/manual/html/resonxk.html>
 
resonxk :: (K k0, K k1, K k2) => [Irate] -> k0 -> k1 -> k2 -> Krate
resonxk i0init k1sig k2cf k3bw = opcode "resonxk" args
  where args = [to k1sig, to k2cf, to k3bw] ++ map to i0init


-- | * opcode : tlineto
--  
--  
-- * syntax : 
--  
--  >   kres tlineto ksig, ktime, ktrig
--  
--  
-- * description : 
--  
--  Generate glissandos starting from a control signal with a
-- trigger.
--  
--  
-- * url : <http://www.csounds.com/manual/html/tlineto.html>
 
tlineto :: (K k0, K k1, K k2) => k0 -> k1 -> k2 -> Krate
tlineto k0sig k1time k2trig = opcode "tlineto" args
  where args = [to k0sig, to k1time, to k2trig]


-- | * opcode : tonek
--  
--  
-- * syntax : 
--  
--  >   kres tonek ksig, khp [, iskip]
--  
--  
-- * description : 
--  
--  A first-order recursive low-pass filter with variable frequency
-- response.
--  
--  
-- * url : <http://www.csounds.com/manual/html/tonek.html>
 
tonek :: (K k0, K k1) => [Irate] -> k0 -> k1 -> Krate
tonek i0init k1sig k2hp = opcode "tonek" args
  where args = [to k1sig, to k2hp] ++ map to i0init