-- | Waveshaping and Phase Distortion
module CsoundExpr.Opcodes.Sigmod.Wavshape
    (chebyshevpoly,
     polynomial,
     powershape,
     pdclip,
     pdhalf,
     pdhalfy)
where



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



-- | * opcode : chebyshevpoly
--  
--  
-- * syntax : 
--  
--  >   aout chebyshevpoly ain, k0 [, k1 [, k2 [...]]]
--  
--  
-- * description : 
--  
--  The chebyshevpoly opcode calculates the value of a polynomial
-- expression with a single a-rate input variable that is made up of
-- a linear combination of the first N Chebyshev polynomials of the
-- first kind. Each Chebyshev polynomial, Tn(x), is weighted by a
-- k-rate coefficient, kn, so that the opcode is calculating a sum
-- of any number of terms in the form kn*Tn(x). Thus, the
-- chebyshevpoly opcode allows for the waveshaping of an audio
-- signal with a dynamic transfer function that gives precise
-- control over the harmonic content of the output.
--  
--  
-- * url : <http://www.csounds.com/manual/html/chebyshevpoly.html>
 
chebyshevpoly :: (K k0) => Arate -> [k0] -> Arate
chebyshevpoly a0in k1vals = opcode "chebyshevpoly" args
  where args = [to a0in] ++ map to k1vals


-- | * opcode : polynomial
--  
--  
-- * syntax : 
--  
--  >   aout polynomial ain, k0 [, k1 [, k2 [...]]]
--  
--  
-- * description : 
--  
--  The polynomial opcode calculates a polynomial with a single
-- a-rate input variable. The polynomial is a sum of any number of
-- terms in the form kn*x^n where kn is the nth coefficient of the
-- expression. These coefficients are k-rate values.
--  
--  
-- * url : <http://www.csounds.com/manual/html/polynomial.html>
 
polynomial :: (K k0) => Arate -> [k0] -> Arate
polynomial a0in k1vals = opcode "polynomial" args
  where args = [to a0in] ++ map to k1vals


-- | * opcode : powershape
--  
--  
-- * syntax : 
--  
--  >   aout powershape ain, kShapeAmount [, ifullscale]
--  
--  
-- * description : 
--  
--  The powershape opcode raises an input signal to a power with
-- pre- and post-scaling of the signal so that the output will be in
-- a predictable range. It also processes negative inputs in a
-- symmetrical way to positive inputs, calculating a dynamic
-- transfer function that is useful for waveshaping.
--  
--  
-- * url : <http://www.csounds.com/manual/html/powershape.html>
 
powershape :: (K k0) => [Irate] -> Arate -> k0 -> Arate
powershape i0init a1in k2ShapeAmount = opcode "powershape" args
  where args = [to a1in, to k2ShapeAmount] ++ map to i0init


-- | * opcode : pdclip
--  
--  
-- * syntax : 
--  
--  >   aout pdclip ain, kWidth, kCenter [, ibipolar [, ifullscale]]
--  
--  
-- * description : 
--  
--  The pdclip opcode allows a percentage of the input range of a
-- signal to be clipped to fullscale. It is similar to simply
-- multiplying the signal and limiting the range of the result, but
-- pdclip allows you to think about how much of the signal range is
-- being distorted instead of the scalar factor and has a offset
-- parameter for assymetric clipping of the signal range. pdclip is
-- also useful for remapping phasors for phase distortion synthesis.
--  
--  
-- * url : <http://www.csounds.com/manual/html/pdclip.html>
 
pdclip :: (K k0, K k1) => [Irate] -> Arate -> k0 -> k1 -> Arate
pdclip i0init a1in k2Width k3Center = opcode "pdclip" args
  where args = [to a1in, to k2Width, to k3Center] ++ map to i0init


-- | * opcode : pdhalf
--  
--  
-- * syntax : 
--  
--  >   aout pdhalf ain, kShapeAmount [, ibipolar [, ifullscale]]
--  
--  
-- * description : 
--  
--  The pdhalf opcode is designed to emulate the "classic" phase
-- distortion synthesis method of the Casio CZ-series of
-- synthesizers from the mid-1980's. This technique reads the first
-- and second halves of a function table at different rates in order
-- to warp the waveform. For example, pdhalf can smoothly transform
-- a sine wave into something approximating the shape of a saw wave.
--  
--  
-- * url : <http://www.csounds.com/manual/html/pdhalf.html>
 
pdhalf :: (K k0) => [Irate] -> Arate -> k0 -> Arate
pdhalf i0init a1in k2ShapeAmount = opcode "pdhalf" args
  where args = [to a1in, to k2ShapeAmount] ++ map to i0init


-- | * opcode : pdhalfy
--  
--  
-- * syntax : 
--  
--  >   aout pdhalfy ain, kShapeAmount [, ibipolar [, ifullscale]]
--  
--  
-- * description : 
--  
--  The pdhalfy opcode is a variation on the phase distortion
-- synthesis method of the pdhalf opcode. It is useful for
-- distorting a phasor in order to read two unequal portions of a
-- table in the same number of samples.
--  
--  
-- * url : <http://www.csounds.com/manual/html/pdhalfy.html>
 
pdhalfy :: (K k0) => [Irate] -> Arate -> k0 -> Arate
pdhalfy i0init a1in k2ShapeAmount = opcode "pdhalfy" args
  where args = [to a1in, to k2ShapeAmount] ++ map to i0init