-- | Additive Synthesis/Resynthesis
module CsoundExpr.Opcodes.Siggen.Additive
    (adsyn,
     adsynt,
     adsynt2,
     hsboscil)
where



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



-- | * opcode : adsyn
--  
--  
-- * syntax : 
--  
--  >   ares adsyn kamod, kfmod, ksmod, ifilcod
--  
--  
-- * description : 
--  
--  Output is an additive set of individually controlled sinusoids,
-- using an oscillator bank.
--  
--  
-- * url : <http://www.csounds.com/manual/html/adsyn.html>
 
adsyn :: (K k0, K k1, K k2) => k0 -> k1 -> k2 -> String -> Arate
adsyn k0amod k1fmod k2smod s3file = opcode "adsyn" args
  where args = [to k0amod, to k1fmod, to k2smod, to s3file]


-- | * opcode : adsynt
--  
--  
-- * syntax : 
--  
--  >   ares adsynt kamp, kcps, iwfn, ifreqfn, iampfn, icnt [, iphs]
--  
--  
-- * description : 
--  
--  Performs additive synthesis with an arbitrary number of
-- partials, not necessarily harmonic.
--  
--  
-- * url : <http://www.csounds.com/manual/html/adsynt.html>
 
adsynt ::
         (K k0, K k1) =>
         [Irate] -> k0 -> k1 -> Irate -> Irate -> Irate -> Irate -> Arate
adsynt i0init k1amp k2cps i3wfn i4freqfn i5ampfn i6cnt
  = opcode "adsynt" args
  where args
          = [to k1amp, to k2cps, to i3wfn, to i4freqfn, to i5ampfn, to i6cnt]
              ++ map to i0init


-- | * opcode : adsynt2
--  
--  
-- * syntax : 
--  
--  >   ar adsynt2 kamp, kcps, iwfn, ifreqfn, iampfn, icnt [, iphs]
--  
--  
-- * description : 
--  
--  Performs additive synthesis with an arbitrary number of
-- partials, not necessarily harmonic. (see adsynt for detailed
-- manual)
--  
--  
-- * url : <http://www.csounds.com/manual/html/adsynt2.html>
 
adsynt2 ::
          (K k0, K k1) =>
          [Irate] -> k0 -> k1 -> Irate -> Irate -> Irate -> Irate -> Arate
adsynt2 i0init k1amp k2cps i3wfn i4freqfn i5ampfn i6cnt
  = opcode "adsynt2" args
  where args
          = [to k1amp, to k2cps, to i3wfn, to i4freqfn, to i5ampfn, to i6cnt]
              ++ map to i0init


-- | * opcode : hsboscil
--  
--  
-- * syntax : 
--  
--  >   ares hsboscil kamp, ktone, kbrite, ibasfreq, iwfn, ioctfn 
--  >       [, ioctcnt] [, iphs]
--  
--  
-- * description : 
--  
--  An oscillator which takes tonality and brightness as arguments,
-- relative to a base frequency.
--  
--  
-- * url : <http://www.csounds.com/manual/html/hsboscil.html>
 
hsboscil ::
           (K k0, K k1, K k2) =>
           [Irate] -> k0 -> k1 -> k2 -> Irate -> Irate -> Irate -> Arate
hsboscil i0init k1amp k2tone k3brite i4basfreq i5wfn i6octfn
  = opcode "hsboscil" args
  where args
          = [to k1amp, to k2tone, to k3brite, to i4basfreq, to i5wfn,
             to i6octfn]
              ++ map to i0init