-- | FM Synthesis
module CsoundExpr.Opcodes.Siggen.Fmsynth
    (foscil,
     foscili,
     crossfm,
     crossfmi,
     crosspm,
     crosspmi,
     crossfmpm,
     crossfmpmi,
     fmb3,
     fmbell,
     fmmetal,
     fmpercfl,
     fmrhode,
     fmvoice,
     fmwurlie)
where



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



-- | * opcode : foscil
--  
--  
-- * syntax : 
--  
--  >   ares foscil xamp, kcps, xcar, xmod, kndx, ifn [, iphs]
--  
--  
-- * description : 
--  
--  A basic frequency modulated oscillator.
--  
--  
-- * url : <http://www.csounds.com/manual/html/foscil.html>
 
foscil ::
         (X x0, K k0, X x1, X x2, K k1) =>
         [Irate] -> x0 -> k0 -> x1 -> x2 -> k1 -> Irate -> Arate
foscil i0init x1amp k2cps x3car x4mod k5ndx i6fn
  = opcode "foscil" args
  where args
          = [to x1amp, to k2cps, to x3car, to x4mod, to k5ndx, to i6fn] ++
              map to i0init


-- | * opcode : foscili
--  
--  
-- * syntax : 
--  
--  >   ares foscili xamp, kcps, xcar, xmod, kndx, ifn [, iphs]
--  
--  
-- * description : 
--  
--  Basic frequency modulated oscillator with linear interpolation.
--  
--  
-- * url : <http://www.csounds.com/manual/html/foscili.html>
 
foscili ::
          (X x0, K k0, X x1, X x2, K k1) =>
          [Irate] -> x0 -> k0 -> x1 -> x2 -> k1 -> Irate -> Arate
foscili i0init x1amp k2cps x3car x4mod k5ndx i6fn
  = opcode "foscili" args
  where args
          = [to x1amp, to k2cps, to x3car, to x4mod, to k5ndx, to i6fn] ++
              map to i0init


-- | * opcode : crossfm
--  
--  
-- * syntax : 
--  
--  >   a1, a2 crossfm xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]
--  >   a1, a2 crossfmi xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]
--  >   a1, a2 crosspm xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]
--  >   a1, a2 crosspmi xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]
--  >   a1, a2 crossfmpm xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]
--  >   a1, a2 crossfmpmi xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]
--  
--  
-- * description : 
--  
--  Two oscillators, mutually frequency and/or phase modulated by
-- each other.
--  
--  
-- * url : <http://www.csounds.com/manual/html/crossfm.html>
 
crossfm ::
          (X x0, X x1, X x2, X x3, K k0) =>
          [Irate] -> x0 -> x1 -> x2 -> x3 -> k0 -> Irate -> Irate -> MultiOut
crossfm i0init x1frq1 x2frq2 x3ndx1 x4ndx2 k5cps i6fn1 i7fn2
  = opcode "crossfm" args
  where args
          = [to x1frq1, to x2frq2, to x3ndx1, to x4ndx2, to k5cps, to i6fn1,
             to i7fn2]
              ++ map to i0init


-- | * opcode : crossfmi
--  
--  
-- * syntax : 
--  
--  >   a1, a2 crossfm xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]
--  >   a1, a2 crossfmi xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]
--  >   a1, a2 crosspm xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]
--  >   a1, a2 crosspmi xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]
--  >   a1, a2 crossfmpm xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]
--  >   a1, a2 crossfmpmi xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]
--  
--  
-- * description : 
--  
--  Two oscillators, mutually frequency and/or phase modulated by
-- each other.
--  
--  
-- * url : <http://www.csounds.com/manual/html/crossfm.html>
 
crossfmi ::
           (X x0, X x1, X x2, X x3, K k0) =>
           [Irate] -> x0 -> x1 -> x2 -> x3 -> k0 -> Irate -> Irate -> MultiOut
crossfmi i0init x1frq1 x2frq2 x3ndx1 x4ndx2 k5cps i6fn1 i7fn2
  = opcode "crossfmi" args
  where args
          = [to x1frq1, to x2frq2, to x3ndx1, to x4ndx2, to k5cps, to i6fn1,
             to i7fn2]
              ++ map to i0init


-- | * opcode : crosspm
--  
--  
-- * syntax : 
--  
--  >   a1, a2 crossfm xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]
--  >   a1, a2 crossfmi xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]
--  >   a1, a2 crosspm xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]
--  >   a1, a2 crosspmi xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]
--  >   a1, a2 crossfmpm xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]
--  >   a1, a2 crossfmpmi xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]
--  
--  
-- * description : 
--  
--  Two oscillators, mutually frequency and/or phase modulated by
-- each other.
--  
--  
-- * url : <http://www.csounds.com/manual/html/crossfm.html>
 
crosspm ::
          (X x0, X x1, X x2, X x3, K k0) =>
          [Irate] -> x0 -> x1 -> x2 -> x3 -> k0 -> Irate -> Irate -> MultiOut
crosspm i0init x1frq1 x2frq2 x3ndx1 x4ndx2 k5cps i6fn1 i7fn2
  = opcode "crosspm" args
  where args
          = [to x1frq1, to x2frq2, to x3ndx1, to x4ndx2, to k5cps, to i6fn1,
             to i7fn2]
              ++ map to i0init


-- | * opcode : crosspmi
--  
--  
-- * syntax : 
--  
--  >   a1, a2 crossfm xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]
--  >   a1, a2 crossfmi xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]
--  >   a1, a2 crosspm xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]
--  >   a1, a2 crosspmi xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]
--  >   a1, a2 crossfmpm xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]
--  >   a1, a2 crossfmpmi xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]
--  
--  
-- * description : 
--  
--  Two oscillators, mutually frequency and/or phase modulated by
-- each other.
--  
--  
-- * url : <http://www.csounds.com/manual/html/crossfm.html>
 
crosspmi ::
           (X x0, X x1, X x2, X x3, K k0) =>
           [Irate] -> x0 -> x1 -> x2 -> x3 -> k0 -> Irate -> Irate -> MultiOut
crosspmi i0init x1frq1 x2frq2 x3ndx1 x4ndx2 k5cps i6fn1 i7fn2
  = opcode "crosspmi" args
  where args
          = [to x1frq1, to x2frq2, to x3ndx1, to x4ndx2, to k5cps, to i6fn1,
             to i7fn2]
              ++ map to i0init


-- | * opcode : crossfmpm
--  
--  
-- * syntax : 
--  
--  >   a1, a2 crossfm xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]
--  >   a1, a2 crossfmi xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]
--  >   a1, a2 crosspm xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]
--  >   a1, a2 crosspmi xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]
--  >   a1, a2 crossfmpm xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]
--  >   a1, a2 crossfmpmi xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]
--  
--  
-- * description : 
--  
--  Two oscillators, mutually frequency and/or phase modulated by
-- each other.
--  
--  
-- * url : <http://www.csounds.com/manual/html/crossfm.html>
 
crossfmpm ::
            (X x0, X x1, X x2, X x3, K k0) =>
            [Irate] -> x0 -> x1 -> x2 -> x3 -> k0 -> Irate -> Irate -> MultiOut
crossfmpm i0init x1frq1 x2frq2 x3ndx1 x4ndx2 k5cps i6fn1 i7fn2
  = opcode "crossfmpm" args
  where args
          = [to x1frq1, to x2frq2, to x3ndx1, to x4ndx2, to k5cps, to i6fn1,
             to i7fn2]
              ++ map to i0init


-- | * opcode : crossfmpmi
--  
--  
-- * syntax : 
--  
--  >   a1, a2 crossfm xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]
--  >   a1, a2 crossfmi xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]
--  >   a1, a2 crosspm xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]
--  >   a1, a2 crosspmi xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]
--  >   a1, a2 crossfmpm xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]
--  >   a1, a2 crossfmpmi xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]
--  
--  
-- * description : 
--  
--  Two oscillators, mutually frequency and/or phase modulated by
-- each other.
--  
--  
-- * url : <http://www.csounds.com/manual/html/crossfm.html>
 
crossfmpmi ::
             (X x0, X x1, X x2, X x3, K k0) =>
             [Irate] -> x0 -> x1 -> x2 -> x3 -> k0 -> Irate -> Irate -> MultiOut
crossfmpmi i0init x1frq1 x2frq2 x3ndx1 x4ndx2 k5cps i6fn1 i7fn2
  = opcode "crossfmpmi" args
  where args
          = [to x1frq1, to x2frq2, to x3ndx1, to x4ndx2, to k5cps, to i6fn1,
             to i7fn2]
              ++ map to i0init


-- | * opcode : fmb3
--  
--  
-- * syntax : 
--  
--  >   ares fmb3 kamp, kfreq, kc1, kc2, kvdepth, kvrate, ifn1, ifn2, ifn3, 
--  >       ifn4, ivfn
--  
--  
-- * description : 
--  
--  Uses FM synthesis to create a Hammond B3 organ sound. It comes
-- from a family of FM sounds, all using 4 basic oscillators and
-- various architectures, as used in the TX81Z synthesizer.
--  
--  
-- * url : <http://www.csounds.com/manual/html/fmb3.html>
 
fmb3 ::
       (K k0, K k1, K k2, K k3, K k4, K k5) =>
       k0 ->
         k1 ->
           k2 ->
             k3 ->
               k4 -> k5 -> Irate -> Irate -> Irate -> Irate -> Irate -> Arate
fmb3 k0amp k1freq k2c1 k3c2 k4vdepth k5vrate i6fn1 i7fn2 i8fn3
  i9fn4 i10vfn = opcode "fmb3" args
  where args
          = [to k0amp, to k1freq, to k2c1, to k3c2, to k4vdepth, to k5vrate,
             to i6fn1, to i7fn2, to i8fn3, to i9fn4, to i10vfn]


-- | * opcode : fmbell
--  
--  
-- * syntax : 
--  
--  >   ares fmbell kamp, kfreq, kc1, kc2, kvdepth, kvrate, ifn1, ifn2, ifn3, 
--  >       ifn4, ivfn
--  
--  
-- * description : 
--  
--  Uses FM synthesis to create a tublar bell sound. It comes from a
-- family of FM sounds, all using 4 basic oscillators and various
-- architectures, as used in the TX81Z synthesizer.
--  
--  
-- * url : <http://www.csounds.com/manual/html/fmbell.html>
 
fmbell ::
         (K k0, K k1, K k2, K k3, K k4, K k5) =>
         k0 ->
           k1 ->
             k2 ->
               k3 ->
                 k4 -> k5 -> Irate -> Irate -> Irate -> Irate -> Irate -> Arate
fmbell k0amp k1freq k2c1 k3c2 k4vdepth k5vrate i6fn1 i7fn2 i8fn3
  i9fn4 i10vfn = opcode "fmbell" args
  where args
          = [to k0amp, to k1freq, to k2c1, to k3c2, to k4vdepth, to k5vrate,
             to i6fn1, to i7fn2, to i8fn3, to i9fn4, to i10vfn]


-- | * opcode : fmmetal
--  
--  
-- * syntax : 
--  
--  >   ares fmmetal kamp, kfreq, kc1, kc2, kvdepth, kvrate, ifn1, ifn2, ifn3, 
--  >       ifn4, ivfn
--  
--  
-- * description : 
--  
--  Uses FM synthesis to create a Heavy Metal sound. It comes from a
-- family of FM sounds, all using 4 basic oscillators and various
-- architectures, as used in the TX81Z synthesizer.
--  
--  
-- * url : <http://www.csounds.com/manual/html/fmmetal.html>
 
fmmetal ::
          (K k0, K k1, K k2, K k3, K k4, K k5) =>
          k0 ->
            k1 ->
              k2 ->
                k3 ->
                  k4 -> k5 -> Irate -> Irate -> Irate -> Irate -> Irate -> Arate
fmmetal k0amp k1freq k2c1 k3c2 k4vdepth k5vrate i6fn1 i7fn2 i8fn3
  i9fn4 i10vfn = opcode "fmmetal" args
  where args
          = [to k0amp, to k1freq, to k2c1, to k3c2, to k4vdepth, to k5vrate,
             to i6fn1, to i7fn2, to i8fn3, to i9fn4, to i10vfn]


-- | * opcode : fmpercfl
--  
--  
-- * syntax : 
--  
--  >   ares fmpercfl kamp, kfreq, kc1, kc2, kvdepth, kvrate, ifn1, ifn2, 
--  >       ifn3, ifn4, ivfn
--  
--  
-- * description : 
--  
--  Uses FM synthesis to create a percussive flute sound. It comes
-- from a family of FM sounds, all using 4 basic oscillators and
-- various architectures, as used in the TX81Z synthesizer.
--  
--  
-- * url : <http://www.csounds.com/manual/html/fmpercfl.html>
 
fmpercfl ::
           (K k0, K k1, K k2, K k3, K k4, K k5) =>
           k0 ->
             k1 ->
               k2 ->
                 k3 ->
                   k4 -> k5 -> Irate -> Irate -> Irate -> Irate -> Irate -> Arate
fmpercfl k0amp k1freq k2c1 k3c2 k4vdepth k5vrate i6fn1 i7fn2 i8fn3
  i9fn4 i10vfn = opcode "fmpercfl" args
  where args
          = [to k0amp, to k1freq, to k2c1, to k3c2, to k4vdepth, to k5vrate,
             to i6fn1, to i7fn2, to i8fn3, to i9fn4, to i10vfn]


-- | * opcode : fmrhode
--  
--  
-- * syntax : 
--  
--  >   ares fmrhode kamp, kfreq, kc1, kc2, kvdepth, kvrate, ifn1, ifn2, 
--  >       ifn3, ifn4, ivfn
--  
--  
-- * description : 
--  
--  Uses FM synthesis to create a Fender Rhodes electric piano
-- sound. It comes from a family of FM sounds, all using 4 basic
-- oscillators and various architectures, as used in the TX81Z
-- synthesizer.
--  
--  
-- * url : <http://www.csounds.com/manual/html/fmrhode.html>
 
fmrhode ::
          (K k0, K k1, K k2, K k3, K k4, K k5) =>
          k0 ->
            k1 ->
              k2 ->
                k3 ->
                  k4 -> k5 -> Irate -> Irate -> Irate -> Irate -> Irate -> Arate
fmrhode k0amp k1freq k2c1 k3c2 k4vdepth k5vrate i6fn1 i7fn2 i8fn3
  i9fn4 i10vfn = opcode "fmrhode" args
  where args
          = [to k0amp, to k1freq, to k2c1, to k3c2, to k4vdepth, to k5vrate,
             to i6fn1, to i7fn2, to i8fn3, to i9fn4, to i10vfn]


-- | * opcode : fmvoice
--  
--  
-- * syntax : 
--  
--  >   ares fmvoice kamp, kfreq, kvowel, ktilt, kvibamt, kvibrate, ifn1, 
--  >       ifn2, ifn3, ifn4, ivibfn
--  
--  
-- * description : 
--  
--  FM Singing Voice Synthesis
--  
--  
-- * url : <http://www.csounds.com/manual/html/fmvoice.html>
 
fmvoice ::
          (K k0, K k1, K k2, K k3, K k4, K k5) =>
          k0 ->
            k1 ->
              k2 ->
                k3 ->
                  k4 -> k5 -> Irate -> Irate -> Irate -> Irate -> Irate -> Arate
fmvoice k0amp k1freq k2vowel k3tilt k4vibamt k5vibrate i6fn1 i7fn2
  i8fn3 i9fn4 i10vibfn = opcode "fmvoice" args
  where args
          = [to k0amp, to k1freq, to k2vowel, to k3tilt, to k4vibamt,
             to k5vibrate, to i6fn1, to i7fn2, to i8fn3, to i9fn4, to i10vibfn]


-- | * opcode : fmwurlie
--  
--  
-- * syntax : 
--  
--  >   ares fmwurlie kamp, kfreq, kc1, kc2, kvdepth, kvrate, ifn1, ifn2, ifn3, 
--  >       ifn4, ivfn
--  
--  
-- * description : 
--  
--  Uses FM synthesis to create a Wurlitzer electric piano sound. It
-- comes from a family of FM sounds, all using 4 basic oscillators
-- and various architectures, as used in the TX81Z synthesizer.
--  
--  
-- * url : <http://www.csounds.com/manual/html/fmwurlie.html>
 
fmwurlie ::
           (K k0, K k1, K k2, K k3, K k4, K k5) =>
           k0 ->
             k1 ->
               k2 ->
                 k3 ->
                   k4 -> k5 -> Irate -> Irate -> Irate -> Irate -> Irate -> Arate
fmwurlie k0amp k1freq k2c1 k3c2 k4vdepth k5vrate i6fn1 i7fn2 i8fn3
  i9fn4 i10vfn = opcode "fmwurlie" args
  where args
          = [to k0amp, to k1freq, to k2c1, to k3c2, to k4vdepth, to k5vrate,
             to i6fn1, to i7fn2, to i8fn3, to i9fn4, to i10vfn]