-- | Vectorial Envelope Generators
module CsoundExpr.Opcodes.Vectorial.EnvelopeGenerators
    (vlinseg,
     vexpseg,
     vcella)
where



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



-- | * opcode : vlinseg
--  
--  
-- * syntax : 
--  
--  >   vlinseg ifnout, ielements, ifn1, idur1, ifn2 [, idur2, ifn3 [...]]
--  
--  
-- * description : 
--  
--  Generate linear vectorial segments
--  
--  
-- * url : <http://www.csounds.com/manual/html/vlinseg.html>
 
vlinseg :: Irate -> Irate -> [Irate] -> SignalOut
vlinseg i0fnout i1elements i2vals = outOpcode "vlinseg" args
  where args = [to i0fnout, to i1elements] ++ map to i2vals


-- | * opcode : vexpseg
--  
--  
-- * syntax : 
--  
--  >   vexpseg ifnout, ielements, ifn1, idur1, ifn2 [, idur2, ifn3 [...]]
--  
--  
-- * description : 
--  
--  Generate exponential vectorial segments
--  
--  
-- * url : <http://www.csounds.com/manual/html/vexpseg.html>
 
vexpseg :: Irate -> Irate -> [Irate] -> SignalOut
vexpseg i0fnout i1elements i2vals = outOpcode "vexpseg" args
  where args = [to i0fnout, to i1elements] ++ map to i2vals


-- | * opcode : vcella
--  
--  
-- * syntax : 
--  
--  >   vcella ktrig, kreinit, ioutFunc, initStateFunc, 
--  >       iRuleFunc, ielements, irulelen [, iradius]
--  
--  
-- * description : 
--  
--  Unidimensional Cellular Automata applied to Csound vectors
--  
--  
-- * url : <http://www.csounds.com/manual/html/vcella.html>
 
vcella ::
         (K k0, K k1) =>
         [Irate] ->
           k0 -> k1 -> Irate -> Irate -> Irate -> Irate -> Irate -> SignalOut
vcella i0init k1trig k2reinit i3outFunc i4nitStateFunc i5RuleFunc
  i6elements i7rulelen = outOpcode "vcella" args
  where args
          = [to k1trig, to k2reinit, to i3outFunc, to i4nitStateFunc,
             to i5RuleFunc, to i6elements, to i7rulelen]
              ++ map to i0init