-- | ATS Spectral Processing
module CsoundExpr.Opcodes.Spectral.ATS
    (atsInfo,
     atsRead,
     atsReadnz,
     atsBufread,
     atsInterpread,
     atsPartialtap,
     atsAdd,
     atsAddnz,
     atsCross,
     atsSinnoi)
where



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



-- | * opcode : ATSinfo
--  
--  
-- * syntax : 
--  
--  >   idata ATSinfo iatsfile, ilocation
--  
--  
-- * description : 
--  
--  atsinfo reads data out of the header of an ATS file.
--  
--  
-- * url : <http://www.csounds.com/manual/html/ATSinfo.html>
 
atsInfo :: Irate -> Irate -> Irate
atsInfo i0atsfile i1location = opcode "ATSinfo" args
  where args = [to i0atsfile, to i1location]


-- | * opcode : ATSread
--  
--  
-- * syntax : 
--  
--  >   kfreq, kamp ATSread ktimepnt, iatsfile, ipartial
--  
--  
-- * description : 
--  
--  ATSread returns the amplitude (kamp) and frequency (kfreq)
-- information of a user specified partial contained in the ATS
-- analysis file at the time indicated by the time pointer ktimepnt.
--  
--  
-- * url : <http://www.csounds.com/manual/html/ATSread.html>
 
atsRead :: (K k0) => k0 -> Irate -> Irate -> MultiOut
atsRead k0timepnt i1atsfile i2partial = opcode "ATSread" args
  where args = [to k0timepnt, to i1atsfile, to i2partial]


-- | * opcode : ATSreadnz
--  
--  
-- * syntax : 
--  
--  >   kenergy ATSreadnz ktimepnt, iatsfile, iband
--  
--  
-- * description : 
--  
--  ATSreadnz returns the energy (kenergy) of a user specified noise
-- band (1-25 bands) at the time indicated by the time pointer
-- ktimepnt.
--  
--  
-- * url : <http://www.csounds.com/manual/html/ATSreadnz.html>
 
atsReadnz :: (K k0) => k0 -> Irate -> Irate -> Krate
atsReadnz k0timepnt i1atsfile i2band = opcode "ATSreadnz" args
  where args = [to k0timepnt, to i1atsfile, to i2band]


-- | * opcode : ATSbufread
--  
--  
-- * syntax : 
--  
--  >   ATSbufread ktimepnt, kfmod, iatsfile, ipartials[, ipartialoffset, 
--  >       ipartialincr]
--  
--  
-- * description : 
--  
--  ATSbufread reads data from and ATS data file and stores it in an
-- internal data table of frequency, amplitude pairs.
--  
--  
-- * url : <http://www.csounds.com/manual/html/ATSbufread.html>
 
atsBufread ::
             (K k0, K k1) => [Irate] -> k0 -> k1 -> Irate -> Irate -> SignalOut
atsBufread i0init k1timepnt k2fmod i3atsfile i4partials
  = outOpcode "ATSbufread" args
  where args
          = [to k1timepnt, to k2fmod, to i3atsfile, to i4partials] ++
              map to i0init


-- | * opcode : ATSinterpread
--  
--  
-- * syntax : 
--  
--  >   kamp ATSinterpread kfreq
--  
--  
-- * description : 
--  
--  ATSinterpread allows a user to determine the frequency envelope
-- of any ATSbufread.
--  
--  
-- * url : <http://www.csounds.com/manual/html/ATSinterpread.html>
 
atsInterpread :: (K k0) => k0 -> Krate
atsInterpread k0freq = opcode "ATSinterpread" args
  where args = [to k0freq]


-- | * opcode : ATSpartialtap
--  
--  
-- * syntax : 
--  
--  >   kfrq, kamp ATSpartialtap ipartialnum
--  
--  
-- * description : 
--  
--  ATSpartialtap takes a partial number and returns a frequency,
-- amplitude pair. The frequency and amplitude data comes from an
-- ATSbufread opcode.
--  
--  
-- * url : <http://www.csounds.com/manual/html/ATSpartialtap.html>
 
atsPartialtap :: Irate -> MultiOut
atsPartialtap i0partialnum = opcode "ATSpartialtap" args
  where args = [to i0partialnum]


-- | * opcode : ATSadd
--  
--  
-- * syntax : 
--  
--  >   ar ATSadd ktimepnt, kfmod, iatsfile, ifn, ipartials[, ipartialoffset, 
--  >       ipartialincr, igatefn]
--  
--  
-- * description : 
--  
--  ATSadd reads from an ATS analysis file and uses the data to
-- perform additive synthesis using an internal array of
-- interpolating oscillators.
--  
--  
-- * url : <http://www.csounds.com/manual/html/ATSadd.html>
 
atsAdd ::
         (K k0, K k1) =>
         [Irate] -> k0 -> k1 -> Irate -> Irate -> Irate -> Arate
atsAdd i0init k1timepnt k2fmod i3atsfile i4fn i5partials
  = opcode "ATSadd" args
  where args
          = [to k1timepnt, to k2fmod, to i3atsfile, to i4fn, to i5partials]
              ++ map to i0init


-- | * opcode : ATSaddnz
--  
--  
-- * syntax : 
--  
--  >   ar ATSaddnz ktimepnt, iatsfile, ibands[, ibandoffset, ibandincr]
--  
--  
-- * description : 
--  
--  ATSaddnz reads from an ATS analysis file and uses the data to
-- perform additive synthesis using a modified randi function.
--  
--  
-- * url : <http://www.csounds.com/manual/html/ATSaddnz.html>
 
atsAddnz :: (K k0) => [Irate] -> k0 -> Irate -> Irate -> Arate
atsAddnz i0init k1timepnt i2atsfile i3bands
  = opcode "ATSaddnz" args
  where args
          = [to k1timepnt, to i2atsfile, to i3bands] ++ map to i0init


-- | * opcode : ATScross
--  
--  
-- * syntax : 
--  
--  >   ar ATScross ktimepnt, kfmod, iatsfile, ifn, kmylev, kbuflev, ipartials 
--  >       [, ipartialoffset, ipartialincr]
--  
--  
-- * description : 
--  
--  ATScross uses data from an ATS analysis file and data from an
-- ATSbufread to perform cross synthesis.
--  
--  
-- * url : <http://www.csounds.com/manual/html/ATScross.html>
 
atsCross ::
           (K k0, K k1, K k2, K k3) =>
           [Irate] -> k0 -> k1 -> Irate -> Irate -> k2 -> k3 -> Irate -> Arate
atsCross i0init k1timepnt k2fmod i3atsfile i4fn k5mylev k6buflev
  i7partials = opcode "ATScross" args
  where args
          = [to k1timepnt, to k2fmod, to i3atsfile, to i4fn, to k5mylev,
             to k6buflev, to i7partials]
              ++ map to i0init


-- | * opcode : ATSsinnoi
--  
--  
-- * syntax : 
--  
--  >   ar ATSsinnoi ktimepnt, ksinlev, knzlev, kfmod, iatsfile, ipartials 
--  >       [, ipartialoffset, ipartialincr]
--  
--  
-- * description : 
--  
--  ATSsinnoi reads data from an ATS data file and uses the
-- information to synthesize sines and noise together.
--  
--  
-- * url : <http://www.csounds.com/manual/html/ATSsinnoi.html>
 
atsSinnoi ::
            (K k0, K k1, K k2, K k3) =>
            [Irate] -> k0 -> k1 -> k2 -> k3 -> Irate -> Irate -> Arate
atsSinnoi i0init k1timepnt k2sinlev k3nzlev k4fmod i5atsfile
  i6partials = opcode "ATSsinnoi" args
  where args
          = [to k1timepnt, to k2sinlev, to k3nzlev, to k4fmod, to i5atsfile,
             to i6partials]
              ++ map to i0init