-- | Linear and Exponential Generators module CsoundExpr.Opcodes.Siggen.Lineexp (exponA, exponK, expcurve, expsegA, expsegK, expsega, expsegrA, expsegrK, gainslider, jsplineA, jsplineK, lineA, lineK, linsegA, linsegK, linsegrA, linsegrK, logcurve, loopseg, loopsegp, lpshold, lpsholdp, rsplineA, rsplineK, scale, transegA, transegK) where import CsoundExpr.Base.Types import CsoundExpr.Base.MultiOut import CsoundExpr.Base.SideEffect import CsoundExpr.Base.UserDefined -- | * opcode : expon -- -- -- * syntax : -- -- > ares expon ia, idur, ib -- > kres expon ia, idur, ib -- -- -- * description : -- -- Trace an exponential curve between specified points. -- -- -- * url : exponA :: Irate -> Irate -> Irate -> Arate exponA i0a i1dur i2b = opcode "expon" args where args = [to i0a, to i1dur, to i2b] -- | * opcode : expon -- -- -- * syntax : -- -- > ares expon ia, idur, ib -- > kres expon ia, idur, ib -- -- -- * description : -- -- Trace an exponential curve between specified points. -- -- -- * url : exponK :: Irate -> Irate -> Irate -> Krate exponK i0a i1dur i2b = opcode "expon" args where args = [to i0a, to i1dur, to i2b] -- | * opcode : expcurve -- -- -- * syntax : -- -- > kout expcurve kindex, ksteepness -- -- -- * description : -- -- Generates an exponential curve in range 0 to 1 of arbitrary -- steepness. Steepness index equal to or lower than 1.0 will result -- in Not-a-Number errors and cause unstable behavior. -- -- -- * url : expcurve :: (K k0, K k1) => k0 -> k1 -> Krate expcurve k0index k1steepness = opcode "expcurve" args where args = [to k0index, to k1steepness] -- | * opcode : expseg -- -- -- * syntax : -- -- > ares expseg ia, idur1, ib [, idur2] [, ic] [...] -- > kres expseg ia, idur1, ib [, idur2] [, ic] [...] -- -- -- * description : -- -- Trace a series of exponential segments between specified points. -- -- -- * url : expsegA :: [Irate] -> Arate expsegA i0vals = opcode "expseg" args where args = map to i0vals -- | * opcode : expseg -- -- -- * syntax : -- -- > ares expseg ia, idur1, ib [, idur2] [, ic] [...] -- > kres expseg ia, idur1, ib [, idur2] [, ic] [...] -- -- -- * description : -- -- Trace a series of exponential segments between specified points. -- -- -- * url : expsegK :: [Irate] -> Krate expsegK i0vals = opcode "expseg" args where args = map to i0vals -- | * opcode : expsega -- -- -- * syntax : -- -- > ares expsega ia, idur1, ib [, idur2] [, ic] [...] -- -- -- * description : -- -- An exponential segment generator operating at a-rate. This unit -- is almost identical to expseg, but more precise when defining -- segments with very short durations (i.e., in a percussive attack -- phase) at audio rate. -- -- -- * url : expsega :: [Irate] -> Arate expsega i0vals = opcode "expsega" args where args = map to i0vals -- | * opcode : expsegr -- -- -- * syntax : -- -- > ares expsegr ia, idur1, ib [, idur2] [, ic] [...], irel, iz -- > kres expsegr ia, idur1, ib [, idur2] [, ic] [...], irel, iz -- -- -- * description : -- -- Trace a series of exponential segments between specified points -- including a release segment. -- -- -- * url : expsegrA :: [Irate] -> Irate -> Irate -> Arate expsegrA i0vals i1rel i2z = opcode "expsegr" args where args = map to i0vals ++ [to i1rel, to i2z] -- | * opcode : expsegr -- -- -- * syntax : -- -- > ares expsegr ia, idur1, ib [, idur2] [, ic] [...], irel, iz -- > kres expsegr ia, idur1, ib [, idur2] [, ic] [...], irel, iz -- -- -- * description : -- -- Trace a series of exponential segments between specified points -- including a release segment. -- -- -- * url : expsegrK :: [Irate] -> Irate -> Irate -> Krate expsegrK i0vals i1rel i2z = opcode "expsegr" args where args = map to i0vals ++ [to i1rel, to i2z] -- | * opcode : gainslider -- -- -- * syntax : -- -- > kout gainslider kindex -- -- -- * description : -- -- This opcode is intended for use to multiply by an audio signal -- to give a console mixer like feel. There is no bounds in the -- source code so you can for example give higher than 127 values -- for extra amplitude but possibly clipped audio. -- -- -- * url : gainslider :: (K k0) => k0 -> Krate gainslider k0index = opcode "gainslider" args where args = [to k0index] -- | * opcode : jspline -- -- -- * syntax : -- -- > ares jspline xamp, kcpsMin, kcpsMax -- > kres jspline kamp, kcpsMin, kcpsMax -- -- -- * description : -- -- A jitter-spline generator. -- -- -- * url : jsplineA :: (X x0, K k0, K k1) => x0 -> k0 -> k1 -> Arate jsplineA x0amp k1cpsMin k2cpsMax = opcode "jspline" args where args = [to x0amp, to k1cpsMin, to k2cpsMax] -- | * opcode : jspline -- -- -- * syntax : -- -- > ares jspline xamp, kcpsMin, kcpsMax -- > kres jspline kamp, kcpsMin, kcpsMax -- -- -- * description : -- -- A jitter-spline generator. -- -- -- * url : jsplineK :: (K k0, K k1, K k2) => k0 -> k1 -> k2 -> Krate jsplineK k0amp k1cpsMin k2cpsMax = opcode "jspline" args where args = [to k0amp, to k1cpsMin, to k2cpsMax] -- | * opcode : line -- -- -- * syntax : -- -- > ares line ia, idur, ib -- > kres line ia, idur, ib -- -- -- * description : -- -- Trace a straight line between specified points. -- -- -- * url : lineA :: Irate -> Irate -> Irate -> Arate lineA i0a i1dur i2b = opcode "line" args where args = [to i0a, to i1dur, to i2b] -- | * opcode : line -- -- -- * syntax : -- -- > ares line ia, idur, ib -- > kres line ia, idur, ib -- -- -- * description : -- -- Trace a straight line between specified points. -- -- -- * url : lineK :: Irate -> Irate -> Irate -> Krate lineK i0a i1dur i2b = opcode "line" args where args = [to i0a, to i1dur, to i2b] -- | * opcode : linseg -- -- -- * syntax : -- -- > ares linseg ia, idur1, ib [, idur2] [, ic] [...] -- > kres linseg ia, idur1, ib [, idur2] [, ic] [...] -- -- -- * description : -- -- Trace a series of line segments between specified points. -- -- -- * url : linsegA :: [Irate] -> Arate linsegA i0vals = opcode "linseg" args where args = map to i0vals -- | * opcode : linseg -- -- -- * syntax : -- -- > ares linseg ia, idur1, ib [, idur2] [, ic] [...] -- > kres linseg ia, idur1, ib [, idur2] [, ic] [...] -- -- -- * description : -- -- Trace a series of line segments between specified points. -- -- -- * url : linsegK :: [Irate] -> Krate linsegK i0vals = opcode "linseg" args where args = map to i0vals -- | * opcode : linsegr -- -- -- * syntax : -- -- > ares linsegr ia, idur1, ib [, idur2] [, ic] [...], irel, iz -- > kres linsegr ia, idur1, ib [, idur2] [, ic] [...], irel, iz -- -- -- * description : -- -- Trace a series of line segments between specified points -- including a release segment. -- -- -- * url : linsegrA :: [Irate] -> Irate -> Irate -> Arate linsegrA i0vals i1rel i2z = opcode "linsegr" args where args = map to i0vals ++ [to i1rel, to i2z] -- | * opcode : linsegr -- -- -- * syntax : -- -- > ares linsegr ia, idur1, ib [, idur2] [, ic] [...], irel, iz -- > kres linsegr ia, idur1, ib [, idur2] [, ic] [...], irel, iz -- -- -- * description : -- -- Trace a series of line segments between specified points -- including a release segment. -- -- -- * url : linsegrK :: [Irate] -> Irate -> Irate -> Krate linsegrK i0vals i1rel i2z = opcode "linsegr" args where args = map to i0vals ++ [to i1rel, to i2z] -- | * opcode : logcurve -- -- -- * syntax : -- -- > kout logcurve kindex, ksteepness -- -- -- * description : -- -- Generates a logarithmic curve in range 0 to 1 of arbitrary -- steepness. Steepness index equal to or lower than 1.0 will result -- in Not-a-Number errors and cause unstable behavior. -- -- -- * url : logcurve :: (K k0, K k1) => k0 -> k1 -> Krate logcurve k0index k1steepness = opcode "logcurve" args where args = [to k0index, to k1steepness] -- | * opcode : loopseg -- -- -- * syntax : -- -- > ksig loopseg kfreq, ktrig, ktime0, kvalue0 [, ktime1] [, kvalue1] -- > [, ktime2] [, kvalue2] [...] -- -- -- * description : -- -- Generate control signal consisting of linear segments delimited -- by two or more specified points. The entire envelope is looped at -- kfreq rate. Each parameter can be varied at k-rate. -- -- -- * url : loopseg :: (K k0, K k1, K k2) => k0 -> k1 -> [k2] -> Krate loopseg k0freq k1trig k2vals = opcode "loopseg" args where args = [to k0freq, to k1trig] ++ map to k2vals -- | * opcode : loopsegp -- -- -- * syntax : -- -- > ksig loopsegp kphase, kvalue0, kdur0, kvalue1 -- > [, kdur1,..., kdurN-1, kvalueN] -- -- -- * description : -- -- Generate control signal consisiting of linear segments delimited -- by two or more specified points. The entire envelope can be -- looped at time-variant rate. Each segment coordinate can also be -- varied at k-rate. -- -- -- * url : loopsegp :: (K k0, K k1) => k0 -> [k1] -> Krate loopsegp k0phase k1vals = opcode "loopsegp" args where args = [to k0phase] ++ map to k1vals -- | * opcode : lpshold -- -- -- * syntax : -- -- > ksig lpshold kfreq, ktrig, ktime0, kvalue0 [, ktime1] [, kvalue1] -- > [, ktime2] [, kvalue2] [...] -- -- -- * description : -- -- Generate control signal consisting of held segments delimited by -- two or more specified points. The entire envelope is looped at -- kfreq rate. Each parameter can be varied at k-rate. -- -- -- * url : lpshold :: (K k0, K k1, K k2) => k0 -> k1 -> [k2] -> Krate lpshold k0freq k1trig k2vals = opcode "lpshold" args where args = [to k0freq, to k1trig] ++ map to k2vals -- | * opcode : lpsholdp -- -- -- * syntax : -- -- > ksig lpsholdp kphase, ktrig, ktime0, kvalue0 [, ktime1] [, kvalue1] -- > [, ktime2] [, kvalue2] [...] -- -- -- * description : -- -- Generate control signal consisiting of held segments delimited -- by two or more specified points. The entire envelope can be -- looped at time-variant rate. Each segment coordinate can also be -- varied at k-rate. -- -- -- * url : lpsholdp :: (K k0, K k1) => k0 -> [k1] -> Krate lpsholdp k0phase k1vals = opcode "lpsholdp" args where args = [to k0phase] ++ map to k1vals -- | * opcode : rspline -- -- -- * syntax : -- -- > ares rspline xrangeMin, xrangeMax, kcpsMin, kcpsMax -- > kres rspline krangeMin, krangeMax, kcpsMin, kcpsMax -- -- -- * description : -- -- Generate random spline curves. -- -- -- * url : rsplineA :: (X x0, X x1, K k0, K k1) => x0 -> x1 -> k0 -> k1 -> Arate rsplineA x0rangeMin x1rangeMax k2cpsMin k3cpsMax = opcode "rspline" args where args = [to x0rangeMin, to x1rangeMax, to k2cpsMin, to k3cpsMax] -- | * opcode : rspline -- -- -- * syntax : -- -- > ares rspline xrangeMin, xrangeMax, kcpsMin, kcpsMax -- > kres rspline krangeMin, krangeMax, kcpsMin, kcpsMax -- -- -- * description : -- -- Generate random spline curves. -- -- -- * url : rsplineK :: (K k0, K k1, K k2, K k3) => k0 -> k1 -> k2 -> k3 -> Krate rsplineK k0rangeMin k1rangeMax k2cpsMin k3cpsMax = opcode "rspline" args where args = [to k0rangeMin, to k1rangeMax, to k2cpsMin, to k3cpsMax] -- | * opcode : scale -- -- -- * syntax : -- -- > kscl scale kinput, kmax, kmin -- -- -- * description : -- -- Scales incoming value to user-definable range. Similar to scale -- object found in popular dataflow languages. -- -- -- * url : scale :: (K k0, K k1, K k2) => k0 -> k1 -> k2 -> Krate scale k0input k1max k2min = opcode "scale" args where args = [to k0input, to k1max, to k2min] -- | * opcode : transeg -- -- -- * syntax : -- -- > ares transeg ia, idur, itype, ib [, idur2] [, itype] [, ic]... -- > kres transeg ia, idur, itype, ib [, idur2] [, itype] [, ic]... -- -- -- * description : -- -- Constructs a user-definable envelope. -- -- -- * url : transegA :: [Irate] -> Arate transegA i0vals = opcode "transeg" args where args = map to i0vals -- | * opcode : transeg -- -- -- * syntax : -- -- > ares transeg ia, idur, itype, ib [, idur2] [, itype] [, ic]... -- > kres transeg ia, idur, itype, ib [, idur2] [, itype] [, ic]... -- -- -- * description : -- -- Constructs a user-definable envelope. -- -- -- * url : transegK :: [Irate] -> Krate transegK i0vals = opcode "transeg" args where args = map to i0vals