-- | Delay
module CsoundExpr.Opcodes.Sigmod.Delay
    (delay,
     delay1,
     delayk,
     delayr,
     delayw,
     deltap,
     deltap3,
     deltapi,
     deltapn,
     deltapx,
     deltapxw,
     vdelay,
     vdelay3,
     vdelayx,
     vdelayxs,
     vdelayxq,
     vdelayxw,
     vdelayxwq,
     vdelayxws,
     multitap)
where



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



-- | * opcode : delay
--  
--  
-- * syntax : 
--  
--  >   ares delay asig, idlt [, iskip]
--  
--  
-- * description : 
--  
--  A signal can be read from or written into a delay path, or it
-- can be automatically delayed by some time interval.
--  
--  
-- * url : <http://www.csounds.com/manual/html/delay.html>
 
delay :: [Irate] -> Arate -> Irate -> Arate
delay i0init a1sig i2dlt = opcode "delay" args
  where args = [to a1sig, to i2dlt] ++ map to i0init


-- | * opcode : delay1
--  
--  
-- * syntax : 
--  
--  >   ares delay1 asig [, iskip]
--  
--  
-- * description : 
--  
--  Delays an input signal by one sample.
--  
--  
-- * url : <http://www.csounds.com/manual/html/delay1.html>
 
delay1 :: [Irate] -> Arate -> Arate
delay1 i0init a1sig = opcode "delay1" args
  where args = [to a1sig] ++ map to i0init


-- | * opcode : delayk
--  
--  
-- * syntax : 
--  
--  >   kr delayk ksig, idel[, imode]
--  >   kr vdel_k ksig, kdel, imdel[, imode]
--  
--  
-- * description : 
--  
--  k-rate delay opcodes
--  
--  
-- * url : <http://www.csounds.com/manual/html/delayk.html>
 
delayk :: (K k0) => [Irate] -> k0 -> Irate -> Krate
delayk i0init k1sig i2del = opcode "delayk" args
  where args = [to k1sig, to i2del] ++ map to i0init


-- | * opcode : delayr
--  
--  
-- * syntax : 
--  
--  >   ares delayr idlt [, iskip]
--  
--  
-- * description : 
--  
--  Reads from an automatically established digital delay line.
--  
--  
-- * url : <http://www.csounds.com/manual/html/delayr.html>
 
delayr :: [Irate] -> Irate -> Arate
delayr i0init i1dlt = opcode "delayr" args
  where args = [to i1dlt] ++ map to i0init


-- | * opcode : delayw
--  
--  
-- * syntax : 
--  
--  >   delayw asig
--  
--  
-- * description : 
--  
--  Writes the audio signal to a digital delay line.
--  
--  
-- * url : <http://www.csounds.com/manual/html/delayw.html>
 
delayw :: Arate -> SignalOut
delayw a0sig = outOpcode "delayw" args
  where args = [to a0sig]


-- | * opcode : deltap
--  
--  
-- * syntax : 
--  
--  >   ares deltap kdlt
--  
--  
-- * description : 
--  
--  Tap a delay line at variable offset times.
--  
--  
-- * url : <http://www.csounds.com/manual/html/deltap.html>
 
deltap :: (K k0) => k0 -> Arate
deltap k0dlt = opcode "deltap" args
  where args = [to k0dlt]


-- | * opcode : deltap3
--  
--  
-- * syntax : 
--  
--  >   ares deltap3 xdlt
--  
--  
-- * description : 
--  
--  Taps a delay line at variable offset times, uses cubic
-- interpolation.
--  
--  
-- * url : <http://www.csounds.com/manual/html/deltap3.html>
 
deltap3 :: (X x0) => x0 -> Arate
deltap3 x0dlt = opcode "deltap3" args
  where args = [to x0dlt]


-- | * opcode : deltapi
--  
--  
-- * syntax : 
--  
--  >   ares deltapi xdlt
--  
--  
-- * description : 
--  
--  Taps a delay line at variable offset times, uses interpolation.
--  
--  
-- * url : <http://www.csounds.com/manual/html/deltapi.html>
 
deltapi :: (X x0) => x0 -> Arate
deltapi x0dlt = opcode "deltapi" args
  where args = [to x0dlt]


-- | * opcode : deltapn
--  
--  
-- * syntax : 
--  
--  >   ares deltapn xnumsamps
--  
--  
-- * description : 
--  
--  Tap a delay line at variable offset times.
--  
--  
-- * url : <http://www.csounds.com/manual/html/deltapn.html>
 
deltapn :: (X x0) => x0 -> Arate
deltapn x0numsamps = opcode "deltapn" args
  where args = [to x0numsamps]


-- | * opcode : deltapx
--  
--  
-- * syntax : 
--  
--  >   aout deltapx adel, iwsize
--  
--  
-- * description : 
--  
--  deltapx is similar to deltapi or deltap3. However, it allows
-- higher quality interpolation. This opcode can read from and write
-- to a delayr/delayw delay line with interpolation.
--  
--  
-- * url : <http://www.csounds.com/manual/html/deltapx.html>
 
deltapx :: Arate -> Irate -> Arate
deltapx a0del i1wsize = opcode "deltapx" args
  where args = [to a0del, to i1wsize]


-- | * opcode : deltapxw
--  
--  
-- * syntax : 
--  
--  >   deltapxw ain, adel, iwsize
--  
--  
-- * description : 
--  
--  deltapxw mixes the input signal to a delay line. This opcode can
-- be mixed with reading units (deltap, deltapn, deltapi, deltap3,
-- and deltapx) in any order; the actual delay time is the
-- difference of the read and write time. This opcode can read from
-- and write to a delayr/delayw delay line with interpolation.
--  
--  
-- * url : <http://www.csounds.com/manual/html/deltapxw.html>
 
deltapxw :: Arate -> Arate -> Irate -> SignalOut
deltapxw a0in a1del i2wsize = outOpcode "deltapxw" args
  where args = [to a0in, to a1del, to i2wsize]


-- | * opcode : vdelay
--  
--  
-- * syntax : 
--  
--  >   ares vdelay asig, adel, imaxdel [, iskip]
--  
--  
-- * description : 
--  
--  This is an interpolating variable time delay, it is not very
-- different from the existing implementation (deltapi), it is only
-- easier to use.
--  
--  
-- * url : <http://www.csounds.com/manual/html/vdelay.html>
 
vdelay :: [Irate] -> Arate -> Arate -> Irate -> Arate
vdelay i0init a1sig a2del i3maxdel = opcode "vdelay" args
  where args = [to a1sig, to a2del, to i3maxdel] ++ map to i0init


-- | * opcode : vdelay3
--  
--  
-- * syntax : 
--  
--  >   ares vdelay3 asig, adel, imaxdel [, iskip]
--  
--  
-- * description : 
--  
--  vdelay3 is experimental. It is the same as vdelay except that it
-- uses cubic interpolation. (New in Version 3.50.)
--  
--  
-- * url : <http://www.csounds.com/manual/html/vdelay3.html>
 
vdelay3 :: [Irate] -> Arate -> Arate -> Irate -> Arate
vdelay3 i0init a1sig a2del i3maxdel = opcode "vdelay3" args
  where args = [to a1sig, to a2del, to i3maxdel] ++ map to i0init


-- | * opcode : vdelayx
--  
--  
-- * syntax : 
--  
--  >   aout vdelayx ain, adl, imd, iws [, ist]
--  
--  
-- * description : 
--  
--  A variable delay opcode with high quality interpolation.
--  
--  
-- * url : <http://www.csounds.com/manual/html/vdelayx.html>
 
vdelayx :: [Irate] -> Arate -> Arate -> Irate -> Irate -> Arate
vdelayx i0init a1in a2dl i3md i4ws = opcode "vdelayx" args
  where args = [to a1in, to a2dl, to i3md, to i4ws] ++ map to i0init


-- | * opcode : vdelayxs
--  
--  
-- * syntax : 
--  
--  >   aout1, aout2 vdelayxs ain1, ain2, adl, imd, iws [, ist]
--  
--  
-- * description : 
--  
--  A stereo variable delay opcode with high quality interpolation.
--  
--  
-- * url : <http://www.csounds.com/manual/html/vdelayxs.html>
 
vdelayxs ::
           [Irate] -> Arate -> Arate -> Arate -> Irate -> Irate -> MultiOut
vdelayxs i0init a1in1 a2in2 a3dl i4md i5ws = opcode "vdelayxs" args
  where args
          = [to a1in1, to a2in2, to a3dl, to i4md, to i5ws] ++ map to i0init


-- | * opcode : vdelayxq
--  
--  
-- * syntax : 
--  
--  >   aout1, aout2, aout3, aout4 vdelayxq ain1, ain2, ain3, ain4, adl, imd, iws [, ist]
--  
--  
-- * description : 
--  
--  A 4-channel variable delay opcode with high quality
-- interpolation.
--  
--  
-- * url : <http://www.csounds.com/manual/html/vdelayxq.html>
 
vdelayxq ::
           [Irate] ->
             Arate ->
               Arate -> Arate -> Arate -> Arate -> Irate -> Irate -> MultiOut
vdelayxq i0init a1in1 a2in2 a3in3 a4in4 a5dl i6md i7ws
  = opcode "vdelayxq" args
  where args
          = [to a1in1, to a2in2, to a3in3, to a4in4, to a5dl, to i6md,
             to i7ws]
              ++ map to i0init


-- | * opcode : vdelayxw
--  
--  
-- * syntax : 
--  
--  >   aout vdelayxw ain, adl, imd, iws [, ist]
--  
--  
-- * description : 
--  
--  Variable delay opcodes with high quality interpolation.
--  
--  
-- * url : <http://www.csounds.com/manual/html/vdelayxw.html>
 
vdelayxw :: [Irate] -> Arate -> Arate -> Irate -> Irate -> Arate
vdelayxw i0init a1in a2dl i3md i4ws = opcode "vdelayxw" args
  where args = [to a1in, to a2dl, to i3md, to i4ws] ++ map to i0init


-- | * opcode : vdelayxwq
--  
--  
-- * syntax : 
--  
--  >   aout1, aout2, aout3, aout4 vdelayxwq ain1, ain2, ain3, ain4, adl, 
--  >       imd, iws [, ist]
--  
--  
-- * description : 
--  
--  Variable delay opcodes with high quality interpolation.
--  
--  
-- * url : <http://www.csounds.com/manual/html/vdelayxwq.html>
 
vdelayxwq ::
            [Irate] ->
              Arate ->
                Arate -> Arate -> Arate -> Arate -> Irate -> Irate -> MultiOut
vdelayxwq i0init a1in1 a2in2 a3in3 a4in4 a5dl i6md i7ws
  = opcode "vdelayxwq" args
  where args
          = [to a1in1, to a2in2, to a3in3, to a4in4, to a5dl, to i6md,
             to i7ws]
              ++ map to i0init


-- | * opcode : vdelayxws
--  
--  
-- * syntax : 
--  
--  >   aout1, aout2 vdelayxws ain1, ain2, adl, imd, iws [, ist]
--  
--  
-- * description : 
--  
--  Variable delay opcodes with high quality interpolation.
--  
--  
-- * url : <http://www.csounds.com/manual/html/vdelayxws.html>
 
vdelayxws ::
            [Irate] -> Arate -> Arate -> Arate -> Irate -> Irate -> MultiOut
vdelayxws i0init a1in1 a2in2 a3dl i4md i5ws
  = opcode "vdelayxws" args
  where args
          = [to a1in1, to a2in2, to a3dl, to i4md, to i5ws] ++ map to i0init


-- | * opcode : multitap
--  
--  
-- * syntax : 
--  
--  >   ares multitap asig [, itime1] [, igain1] [, itime2] [, igain2] [...]
--  
--  
-- * description : 
--  
--  Multitap delay line implementation.
--  
--  
-- * url : <http://www.csounds.com/manual/html/multitap.html>
 
multitap :: Arate -> [Irate] -> Arate
multitap a0sig i1vals = opcode "multitap" args
  where args = [to a0sig] ++ map to i1vals