-- | Sensing and Control module CsoundExpr.Opcodes.Control.Sensing (button, checkbox, control, setctrl, sensekey, xyin, follow, follow2, peakA, peakK, rms, ptrack, pitch, pitchamdf, tempest, tempo, miditempo, tempoval, seqtime, seqtime2, trigger, timedseq, changed, getcfg, rewindscore) where import CsoundExpr.Base.Types import CsoundExpr.Base.MultiOut import CsoundExpr.Base.SideEffect import CsoundExpr.Base.UserDefined -- | * opcode : button -- -- -- * syntax : -- -- > kres button knum -- -- -- * description : -- -- Sense on-screen controls. Requires Winsound or TCL/TK. -- -- -- * url : button :: (K k0) => k0 -> Krate button k0num = opcode "button" args where args = [to k0num] -- | * opcode : checkbox -- -- -- * syntax : -- -- > kres checkbox knum -- -- -- * description : -- -- Sense on-screen controls. Requires Winsound or TCL/TK. -- -- -- * url : checkbox :: (K k0) => k0 -> Krate checkbox k0num = opcode "checkbox" args where args = [to k0num] -- | * opcode : control -- -- -- * syntax : -- -- > kres control knum -- -- -- * description : -- -- Configurable slider controls for realtime user input. Requires -- Winsound or TCL/TK. control reads a slider's value. -- -- -- * url : control :: (K k0) => k0 -> Krate control k0num = opcode "control" args where args = [to k0num] -- | * opcode : setctrl -- -- -- * syntax : -- -- > setctrl inum, ival, itype -- -- -- * description : -- -- Configurable slider controls for realtime user input. Requires -- Winsound or TCL/TK. setctrl sets a slider to a specific value, or -- sets a minimum or maximum range. -- -- -- * url : setctrl :: Irate -> Irate -> Irate -> SignalOut setctrl i0num i1val i2type = outOpcode "setctrl" args where args = [to i0num, to i1val, to i2type] -- | * opcode : sensekey -- -- -- * syntax : -- -- > kres[, kkeydown] sensekey -- -- -- * description : -- -- Returns the ASCII code of a key that has been pressed, or -1 if -- no key has been pressed. -- -- -- * url : sensekey :: MultiOut sensekey = opcode "sensekey" args where args = [] -- | * opcode : xyin -- -- -- * syntax : -- -- > kx, ky xyin iprd, ixmin, ixmax, iymin, iymax [, ixinit] [, iyinit] -- -- -- * description : -- -- Sense the cursor position in an output window. When xyin is -- called the position of the mouse within the output window is used -- to reply to the request. This simple mechanism does mean that -- only one xyin can be used accurately at once. The position of the -- mouse is reported in the output window. -- -- -- * url : xyin :: [Irate] -> Irate -> Irate -> Irate -> Irate -> Irate -> MultiOut xyin i0init i1prd i2xmin i3xmax i4ymin i5ymax = opcode "xyin" args where args = [to i1prd, to i2xmin, to i3xmax, to i4ymin, to i5ymax] ++ map to i0init -- | * opcode : follow -- -- -- * syntax : -- -- > ares follow asig, idt -- -- -- * description : -- -- Envelope follower unit generator. -- -- -- * url : follow :: Arate -> Irate -> Arate follow a0sig i1dt = opcode "follow" args where args = [to a0sig, to i1dt] -- | * opcode : follow2 -- -- -- * syntax : -- -- > ares follow2 asig, katt, krel -- -- -- * description : -- -- A controllable envelope extractor using the algorithm attributed -- to Jean-Marc Jot. -- -- -- * url : follow2 :: (K k0, K k1) => Arate -> k0 -> k1 -> Arate follow2 a0sig k1att k2rel = opcode "follow2" args where args = [to a0sig, to k1att, to k2rel] -- | * opcode : peak -- -- -- * syntax : -- -- > kres peak asig -- > kres peak ksig -- -- -- * description : -- -- These opcodes maintain the output k-rate variable as the peak -- absolute level so far received. -- -- -- * url : peakA :: Arate -> Krate peakA a0sig = opcode "peak" args where args = [to a0sig] -- | * opcode : peak -- -- -- * syntax : -- -- > kres peak asig -- > kres peak ksig -- -- -- * description : -- -- These opcodes maintain the output k-rate variable as the peak -- absolute level so far received. -- -- -- * url : peakK :: (K k0) => k0 -> Krate peakK k0sig = opcode "peak" args where args = [to k0sig] -- | * opcode : rms -- -- -- * syntax : -- -- > kres rms asig [, ihp] [, iskip] -- -- -- * description : -- -- Determines the root-mean-square amplitude of an audio signal. It -- low-pass filters the actual value, to average in the manner of a -- VU meter. -- -- -- * url : rms :: [Irate] -> Arate -> Krate rms i0init a1sig = opcode "rms" args where args = [to a1sig] ++ map to i0init -- | * opcode : ptrack -- -- -- * syntax : -- -- > kcps, kamp ptrack asig, ihopsize[,ipeaks] -- -- -- * description : -- -- ptrack takes an input signal, splits it into ihopsize blocks and -- using a STFT method, extracts an estimated pitch for its -- fundamental frequency as well as estimating the total amplitude -- of the signal in dB, relative to full-scale (0dB). The method -- implies an analysis window size of 2*ihopsize samples (overlaping -- by 1/2 window), which has to be a power-of-two, between 128 and -- 8192 (hopsizes between 64 and 4096). Smaller windows will give -- better time precision, but worse frequency accuracy (esp. in low -- fundamentals).This opcode is based on an original algorithm by M. -- Puckette. -- -- -- * url : ptrack :: [Irate] -> Arate -> Irate -> MultiOut ptrack i0init a1sig i2hopsize = opcode "ptrack" args where args = [to a1sig, to i2hopsize] ++ map to i0init -- | * opcode : pitch -- -- -- * syntax : -- -- > koct, kamp pitch asig, iupdte, ilo, ihi, idbthresh [, ifrqs] [, iconf] -- > [, istrt] [, iocts] [, iq] [, inptls] [, irolloff] [, iskip] -- -- -- * description : -- -- Using the same techniques as spectrum and specptrk, pitch tracks -- the pitch of the signal in octave point decimal form, and -- amplitude in dB. -- -- -- * url : pitch :: [Irate] -> Arate -> Irate -> Irate -> Irate -> Irate -> MultiOut pitch i0init a1sig i2updte i3lo i4hi i5dbthresh = opcode "pitch" args where args = [to a1sig, to i2updte, to i3lo, to i4hi, to i5dbthresh] ++ map to i0init -- | * opcode : pitchamdf -- -- -- * syntax : -- -- > kcps, krms pitchamdf asig, imincps, imaxcps [, icps] [, imedi] -- > [, idowns] [, iexcps] [, irmsmedi] -- -- -- * description : -- -- Follows the pitch of a signal based on the AMDF method (Average -- Magnitude Difference Function). Outputs pitch and amplitude -- tracking signals. The method is quite fast and should run in -- realtime. This technique usually works best for monophonic -- signals. -- -- -- * url : pitchamdf :: [Irate] -> Arate -> Irate -> Irate -> MultiOut pitchamdf i0init a1sig i2mincps i3maxcps = opcode "pitchamdf" args where args = [to a1sig, to i2mincps, to i3maxcps] ++ map to i0init -- | * opcode : tempest -- -- -- * syntax : -- -- > ktemp tempest kin, iprd, imindur, imemdur, ihp, ithresh, ihtim, ixfdbak, -- > istartempo, ifn [, idisprd] [, itweek] -- -- -- * description : -- -- Estimate the tempo of beat patterns in a control signal. -- -- -- * url : tempest :: (K k0) => [Irate] -> k0 -> Irate -> Irate -> Irate -> Irate -> Irate -> Irate -> Irate -> Irate -> Irate -> Krate tempest i0init k1in i2prd i3mindur i4memdur i5hp i6thresh i7htim i8xfdbak i9startempo i10fn = opcode "tempest" args where args = [to k1in, to i2prd, to i3mindur, to i4memdur, to i5hp, to i6thresh, to i7htim, to i8xfdbak, to i9startempo, to i10fn] ++ map to i0init -- | * opcode : tempo -- -- -- * syntax : -- -- > tempo ktempo, istartempo -- -- -- * description : -- -- Apply tempo control to an uninterpreted score. -- -- -- * url : tempo :: (K k0) => k0 -> Irate -> SignalOut tempo k0tempo i1startempo = outOpcode "tempo" args where args = [to k0tempo, to i1startempo] -- | * opcode : miditempo -- -- -- * syntax : -- -- > ksig miditempo -- -- -- * description : -- -- Returns the current tempo at k-rate, of either the MIDI file (if -- available) or the score -- -- -- * url : miditempo :: Krate miditempo = opcode "miditempo" args where args = [] -- | * opcode : tempoval -- -- -- * syntax : -- -- > kres tempoval -- -- -- * description : -- -- Reads the current value of the tempo. -- -- -- * url : tempoval :: Krate tempoval = opcode "tempoval" args where args = [] -- | * opcode : seqtime -- -- -- * syntax : -- -- > ktrig_out seqtime ktime_unit, kstart, kloop, kinitndx, kfn_times -- -- -- * description : -- -- Generates a trigger signal according to the values stored in a -- table. -- -- -- * url : seqtime :: (K k0, K k1, K k2, K k3, K k4) => k0 -> k1 -> k2 -> k3 -> k4 -> Krate seqtime k0time_unit k1start k2loop k3initndx k4fn_times = opcode "seqtime" args where args = [to k0time_unit, to k1start, to k2loop, to k3initndx, to k4fn_times] -- | * opcode : seqtime2 -- -- -- * syntax : -- -- > ktrig_out seqtime2 ktrig_in, ktime_unit, kstart, kloop, kinitndx, kfn_times -- -- -- * description : -- -- Generates a trigger signal according to the values stored in a -- table. -- -- -- * url : seqtime2 :: (K k0, K k1, K k2, K k3, K k4, K k5) => k0 -> k1 -> k2 -> k3 -> k4 -> k5 -> Krate seqtime2 k0trig_in k1time_unit k2start k3loop k4initndx k5fn_times = opcode "seqtime2" args where args = [to k0trig_in, to k1time_unit, to k2start, to k3loop, to k4initndx, to k5fn_times] -- | * opcode : trigger -- -- -- * syntax : -- -- > kout trigger ksig, kthreshold, kmode -- -- -- * description : -- -- Informs when a krate signal crosses a threshold. -- -- -- * url : trigger :: (K k0, K k1, K k2) => k0 -> k1 -> k2 -> Krate trigger k0sig k1threshold k2mode = opcode "trigger" args where args = [to k0sig, to k1threshold, to k2mode] -- | * opcode : timedseq -- -- -- * syntax : -- -- > ktrig timedseq ktimpnt, ifn, kp1 [,kp2, kp3,...,kpN] -- -- -- * description : -- -- An event-sequencer in which time can be controlled by a -- time-pointer. Sequence data are stored into a table. -- -- -- * url : timedseq :: (K k0, K k1) => k0 -> Irate -> [k1] -> Krate timedseq k0timpnt i1fn k2pN = opcode "timedseq" args where args = [to k0timpnt, to i1fn] ++ map to k2pN -- | * opcode : changed -- -- -- * syntax : -- -- > ktrig changed kvar1 [, kvar2,..., kvarN] -- -- -- * description : -- -- This opcode outputs a trigger signal that informs when any one -- of its k-rate arguments has changed. Useful with valuator widgets -- or MIDI controllers. -- -- -- * url : changed :: (K k0) => [k0] -> Krate changed k0varN = opcode "changed" args where args = map to k0varN -- | * opcode : getcfg -- -- -- * syntax : -- -- > Svalue getcfg iopt -- -- -- * description : -- -- Return various configuration settings in Svalue as a string at -- init time. -- -- -- * url : getcfg :: Irate -> String getcfg i0opt = opcode "getcfg" args where args = [to i0opt] -- | * opcode : rewindscore -- -- -- * syntax : -- -- > rewindscore -- -- -- * description : -- -- Rewinds the playback position of the current score performance.. -- -- -- * url : rewindscore :: SignalOut rewindscore = outOpcode "rewindscore" args where args = []