-- | Amplitude Modifiers and Dynamic processing
module CsoundExpr.Opcodes.Sigmod.SigProcAmpMod
    (balance,
     compress,
     clip,
     dam,
     gain)
where



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



-- | * opcode : balance
--  
--  
-- * syntax : 
--  
--  >   ares balance asig, acomp [, ihp] [, iskip]
--  
--  
-- * description : 
--  
--  The rms power of asig can be interrogated, set, or adjusted to
-- match that of a comparator signal.
--  
--  
-- * url : <http://www.csounds.com/manual/html/balance.html>
 
balance :: [Irate] -> Arate -> Arate -> Arate
balance i0init a1sig a2comp = opcode "balance" args
  where args = [to a1sig, to a2comp] ++ map to i0init


-- | * opcode : compress
--  
--  
-- * syntax : 
--  
--  >   ar compress aasig, acsig, kthresh, kloknee, khiknee, kratio, katt, krel, ilook
--  
--  
-- * description : 
--  
--  This unit functions as an audio compressor, limiter, expander,
-- or noise gate, using either soft-knee or hard-knee mapping, and
-- with dynamically variable performance characteristics. It takes
-- two audio input signals, aasig and acsig, the first of which is
-- modified by a running analysis of the second. Both signals can be
-- the same, or the first can be modified by a different controlling
-- signal.
--  
--  
-- * url : <http://www.csounds.com/manual/html/compress.html>
 
compress ::
           (K k0, K k1, K k2, K k3, K k4, K k5) =>
           Arate ->
             Arate -> k0 -> k1 -> k2 -> k3 -> k4 -> k5 -> Irate -> Arate
compress a0asig a1csig k2thresh k3loknee k4hiknee k5ratio k6att
  k7rel i8look = opcode "compress" args
  where args
          = [to a0asig, to a1csig, to k2thresh, to k3loknee, to k4hiknee,
             to k5ratio, to k6att, to k7rel, to i8look]


-- | * opcode : clip
--  
--  
-- * syntax : 
--  
--  >   ares clip asig, imeth, ilimit [, iarg]
--  
--  
-- * description : 
--  
--  Clips an a-rate signal to a predefined limit, in a soft manner,
-- using one of three methods.
--  
--  
-- * url : <http://www.csounds.com/manual/html/clip.html>
 
clip :: [Irate] -> Arate -> Irate -> Irate -> Arate
clip i0init a1sig i2meth i3limit = opcode "clip" args
  where args = [to a1sig, to i2meth, to i3limit] ++ map to i0init


-- | * opcode : dam
--  
--  
-- * syntax : 
--  
--  >   ares dam asig, kthreshold, icomp1, icomp2, irtime, iftime
--  
--  
-- * description : 
--  
--  This opcode dynamically modifies a gain value applied to the
-- input sound ain by comparing its power level to a given threshold
-- level. The signal will be compressed/expanded with different
-- factors regarding that it is over or under the threshold.
--  
--  
-- * url : <http://www.csounds.com/manual/html/dam.html>
 
dam ::
      (K k0) => Arate -> k0 -> Irate -> Irate -> Irate -> Irate -> Arate
dam a0sig k1threshold i2comp1 i3comp2 i4rtime i5ftime
  = opcode "dam" args
  where args
          = [to a0sig, to k1threshold, to i2comp1, to i3comp2, to i4rtime,
             to i5ftime]


-- | * opcode : gain
--  
--  
-- * syntax : 
--  
--  >   ares gain asig, krms [, ihp] [, iskip]
--  
--  
-- * description : 
--  
--  Adjusts the amplitude audio signal according to a
-- root-mean-square value.
--  
--  
-- * url : <http://www.csounds.com/manual/html/gain.html>
 
gain :: (K k0) => [Irate] -> Arate -> k0 -> Arate
gain i0init a1sig k2rms = opcode "gain" args
  where args = [to a1sig, to k2rms] ++ map to i0init