-- | Short-time Fourier Transform (STFT) Resynthesis
module CsoundExpr.Opcodes.Spectral.SiggenStft
    (tableseg,
     pvadd,
     pvbufread,
     pvcross,
     pvinterp,
     pvoc,
     pvread,
     tablexseg,
     vpvoc)
where



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



-- | * opcode : tableseg
--  
--  
-- * syntax : 
--  
--  >   tableseg ifn1, idur1, ifn2 [, idur2] [, ifn3] [...]
--  
--  
-- * description : 
--  
--  tableseg is like linseg but interpolate between values in a
-- stored function tables. The result is a new function table passed
-- internally to any following vpvoc which occurs before a
-- subsequent tableseg (much like lpread/lpreson pairs work). The
-- uses of these are described below under vpvoc.
--  
--  
-- * url : <http://www.csounds.com/manual/html/tableseg.html>
 
tableseg :: [Irate] -> SignalOut
tableseg i0ifns = outOpcode "tableseg" args
  where args = map to i0ifns


-- | * opcode : pvadd
--  
--  
-- * syntax : 
--  
--  >   ares pvadd ktimpnt, kfmod, ifilcod, ifn, ibins [, ibinoffset] 
--  >       [, ibinincr] [, iextractmode] [, ifreqlim] [, igatefn]
--  
--  
-- * description : 
--  
--  pvadd reads from a pvoc file and uses the data to perform
-- additive synthesis using an internal array of interpolating
-- oscillators. The user supplies the wave table (usually one period
-- of a sine wave), and can choose which analysis bins will be used
-- in the re-synthesis.
--  
--  
-- * url : <http://www.csounds.com/manual/html/pvadd.html>
 
pvadd ::
        (K k0, K k1) =>
        [Irate] -> k0 -> k1 -> String -> Irate -> Irate -> Arate
pvadd i0init k1timpnt k2fmod s3file i4fn i5bins
  = opcode "pvadd" args
  where args
          = [to k1timpnt, to k2fmod, to s3file, to i4fn, to i5bins] ++
              map to i0init


-- | * opcode : pvbufread
--  
--  
-- * syntax : 
--  
--  >   pvbufread ktimpnt, ifile
--  
--  
-- * description : 
--  
--  pvbufread reads from a pvoc file and makes the retrieved data
-- available to any following pvinterp and pvcross units that appear
-- in an instrument before a subsequent pvbufread (just as lpread
-- and lpreson work together). The data is passed internally and the
-- unit has no output of its own.
--  
--  
-- * url : <http://www.csounds.com/manual/html/pvbufread.html>
 
pvbufread :: (K k0) => k0 -> Irate -> SignalOut
pvbufread k0timpnt i1file = outOpcode "pvbufread" args
  where args = [to k0timpnt, to i1file]


-- | * opcode : pvcross
--  
--  
-- * syntax : 
--  
--  >   ares pvcross ktimpnt, kfmod, ifile, kampscale1, kampscale2 [, ispecwp]
--  
--  
-- * description : 
--  
--  pvcross applies the amplitudes from one phase vocoder analysis
-- file to the data from a second file and then performs the
-- resynthesis. The data is passed, as described above, from a
-- previously called pvbufread unit. The two k-rate amplitude
-- arguments are used to scale the amplitudes of each files
-- separately before they are added together and used in the
-- resynthesis (see below for further explanation). The frequencies
-- of the first file are not used at all in this process. This unit
-- simply allows for cross-synthesis through the application of the
-- amplitudes of the spectra of one signal to the frequencies of a
-- second signal. Unlike pvinterp, pvcross does allow for the use of
-- the ispecwp as in pvoc and vpvoc.
--  
--  
-- * url : <http://www.csounds.com/manual/html/pvcross.html>
 
pvcross ::
          (K k0, K k1, K k2, K k3) =>
          [Irate] -> k0 -> k1 -> Irate -> k2 -> k3 -> Arate
pvcross i0init k1timpnt k2fmod i3file k4ampscale1 k5ampscale2
  = opcode "pvcross" args
  where args
          = [to k1timpnt, to k2fmod, to i3file, to k4ampscale1,
             to k5ampscale2]
              ++ map to i0init


-- | * opcode : pvinterp
--  
--  
-- * syntax : 
--  
--  >   ares pvinterp ktimpnt, kfmod, ifile, kfreqscale1, kfreqscale2, 
--  >       kampscale1, kampscale2, kfreqinterp, kampinterp
--  
--  
-- * description : 
--  
--  pvinterp interpolates between the amplitudes and frequencies, on
-- a bin by bin basis, of two phase vocoder analysis files (one from
-- a previously called pvbufread unit and the other from within its
-- own argument list), allowing for user defined transitions between
-- analyzed sounds. It also allows for general scaling of the
-- amplitudes and frequencies of each file separately before the
-- interpolated values are calculated and sent to the resynthesis
-- routines. The kfmod argument in pvinterp performs its frequency
-- scaling on the frequency values after their derivation from the
-- separate scaling and subsequent interpolation is performed so
-- that this acts as an overall scaling value of the new frequency
-- components.
--  
--  
-- * url : <http://www.csounds.com/manual/html/pvinterp.html>
 
pvinterp ::
           (K k0, K k1, K k2, K k3, K k4, K k5, K k6, K k7) =>
           k0 -> k1 -> Irate -> k2 -> k3 -> k4 -> k5 -> k6 -> k7 -> Arate
pvinterp k0timpnt k1fmod i2file k3freqscale1 k4freqscale2
  k5ampscale1 k6ampscale2 k7freqinterp k8ampinterp
  = opcode "pvinterp" args
  where args
          = [to k0timpnt, to k1fmod, to i2file, to k3freqscale1,
             to k4freqscale2, to k5ampscale1, to k6ampscale2, to k7freqinterp,
             to k8ampinterp]


-- | * opcode : pvoc
--  
--  
-- * syntax : 
--  
--  >   ares pvoc ktimpnt, kfmod, ifilcod [, ispecwp] [, iextractmode] 
--  >       [, ifreqlim] [, igatefn]
--  
--  
-- * description : 
--  
--  Implements signal reconstruction using an fft-based phase
-- vocoder.
--  
--  
-- * url : <http://www.csounds.com/manual/html/pvoc.html>
 
pvoc :: (K k0, K k1) => [Irate] -> k0 -> k1 -> String -> Arate
pvoc i0init k1timpnt k2fmod s3file = opcode "pvoc" args
  where args = [to k1timpnt, to k2fmod, to s3file] ++ map to i0init


-- | * opcode : pvread
--  
--  
-- * syntax : 
--  
--  >   kfreq, kamp pvread ktimpnt, ifile, ibin
--  
--  
-- * description : 
--  
--  pvread reads from a pvoc file and returns the frequency and
-- amplitude from a single analysis channel or bin. The returned
-- values can be used anywhere else in the Csound instrument. For
-- example, one can use them as arguments to an oscillator to
-- synthesize a single component from an analyzed signal or a bank
-- of pvreads can be used to resynthesize the analyzed sound using
-- additive synthesis by passing the frequency and magnitude values
-- to a bank of oscillators.
--  
--  
-- * url : <http://www.csounds.com/manual/html/pvread.html>
 
pvread :: (K k0) => k0 -> Irate -> Irate -> MultiOut
pvread k0timpnt i1file i2bin = opcode "pvread" args
  where args = [to k0timpnt, to i1file, to i2bin]


-- | * opcode : tablexseg
--  
--  
-- * syntax : 
--  
--  >   tablexseg ifn1, idur1, ifn2 [, idur2] [, ifn3] [...]
--  
--  
-- * description : 
--  
--  tablexseg is like expseg but interpolate between values in a
-- stored function tables. The result is a new function table passed
-- internally to any following vpvoc which occurs before a
-- subsequent tablexseg (much like lpread/lpreson pairs work). The
-- uses of these are described below under vpvoc.
--  
--  
-- * url : <http://www.csounds.com/manual/html/tablexseg.html>
 
tablexseg :: [Irate] -> SignalOut
tablexseg i0ifns = outOpcode "tablexseg" args
  where args = map to i0ifns


-- | * opcode : vpvoc
--  
--  
-- * syntax : 
--  
--  >   ares vpvoc ktimpnt, kfmod, ifile [, ispecwp] [, ifn]
--  
--  
-- * description : 
--  
--  Implements signal reconstruction using an fft-based phase
-- vocoder and an extra envelope.
--  
--  
-- * url : <http://www.csounds.com/manual/html/vpvoc.html>
 
vpvoc :: (K k0, K k1) => [Irate] -> k0 -> k1 -> Irate -> Arate
vpvoc i0init k1timpnt k2fmod i3file = opcode "vpvoc" args
  where args = [to k1timpnt, to k2fmod, to i3file] ++ map to i0init