├── .gitignore ├── ugens ├── PSinGrain.lisp ├── SC3plugins │ ├── LadspaUGen.lisp │ ├── TJUGens.lisp │ ├── NHUGens.lisp │ ├── MdaUGens.lisp │ ├── PitchDetection.lisp │ ├── DistortionPlugins.lisp │ ├── DEINDUGens.lisp │ ├── MCLDUGens.lisp │ ├── JoshUGens.lisp │ ├── SLUGens.lisp │ └── BhobUGens.lisp ├── Pluck.lisp ├── PitchShift.lisp ├── MoogFF.lisp ├── TestUGens.lisp ├── GVerb.lisp ├── quarks │ ├── redSys │ │ └── RedImpulse.lisp │ └── miSCellaneous_lib │ │ └── WaveFolding.lisp ├── FreeVerb.lisp ├── Hilbert.lisp ├── PhysicalModel.lisp ├── SoundIn.lisp ├── DiskIO.lisp ├── PartConv.lisp ├── Poll.lisp ├── Splay.lisp ├── MacUGens.lisp ├── Compander.lisp ├── IEnvGen.lisp ├── InfoUGens.lisp ├── Gendyn.lisp ├── MachineListening.lisp ├── GrainUGens.lisp ├── BEQSuite.lisp ├── Extensions │ ├── DynGen.lisp │ ├── mi-UGens.lisp │ ├── PortedPlugins.lisp │ └── f0plugins.lisp ├── Pan.lisp ├── FFTUnpacking.lisp ├── InOut.lisp ├── Chaos.lisp ├── Demand.lisp ├── BufIO.lisp ├── FSinOsc.lisp ├── Line.lisp ├── Delays.lisp ├── Noise.lisp ├── FFT.lisp ├── Trig.lisp ├── Osc.lisp └── Filter.lisp ├── osc ├── package.lisp ├── sc-osc.asd ├── ecl-extension.lisp ├── lw-extension.lisp ├── transmit.lisp └── osc.lisp ├── slynk-extensions.lisp ├── swank-extensions.lisp ├── LICENCE ├── server-options.lisp ├── id-map.lisp ├── bus.lisp ├── cl-collider.asd ├── package.lisp ├── util.lisp └── README.md /.gitignore: -------------------------------------------------------------------------------- 1 | .DS_Store -------------------------------------------------------------------------------- /ugens/PSinGrain.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defugen (p-sin-grain "PSinGrain") 4 | (&optional (freq 440.0) (dur 0.2) (amp 0.1)) 5 | ((:ar (multinew new 'ugen freq dur amp)))) 6 | 7 | -------------------------------------------------------------------------------- /ugens/SC3plugins/LadspaUGen.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-collider) 2 | 3 | (defugen (ladspa "LADSPA") 4 | (num-channels id &rest args) 5 | ((:ar (multinew-list new 'multiout-ugen (append (list num-channels num-channels id) args))))) 6 | -------------------------------------------------------------------------------- /osc/package.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:sc-osc 2 | (:use #:cl) 3 | (:export 4 | #:osc-device 5 | #:send-message 6 | #:send-bundle 7 | #:close-device 8 | #:debug-msg 9 | #:add-osc-responder 10 | #:remove-osc-responder)) 11 | -------------------------------------------------------------------------------- /ugens/Pluck.lisp: -------------------------------------------------------------------------------- 1 | (in-package :sc) 2 | 3 | (defugen (pluck "Pluck") 4 | (&optional (in 0.0) (trig 1.0) (max-deltime 0.2) (deltime 0.2) (decaytime 1.0) 5 | (coef 0.5) &key (mul 1) (add 0)) 6 | ((:ar (madd (multinew new 'ugen in trig max-deltime deltime decaytime coef) 7 | mul add)))) 8 | -------------------------------------------------------------------------------- /ugens/SC3plugins/TJUGens.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defugen (dfm-1 "DFM1") 4 | (in &optional (freq 1000) (res 0.1) (input-gain 1) (type 0) (noise-level 0.0003) (mul 1) (add 0)) 5 | ((:ar 6 | (madd (multinew new 'pure-ugen in freq res input-gain type noise-level) mul add))) 7 | :check-fn #'check-same-rate-as-first-input) 8 | -------------------------------------------------------------------------------- /ugens/PitchShift.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defugen (pitch-shift "PitchShift") (&optional (in 0.0) (window-size 0.2) (pitch-ratio 1.0) (pitch-dispersion 0.0) (time-dispersion 0.0) 4 | &key (mul 1.0) (add 0.0)) 5 | ((:ar (madd (multinew new 'pure-ugen in window-size pitch-ratio pitch-dispersion time-dispersion) 6 | mul add)))) 7 | -------------------------------------------------------------------------------- /ugens/MoogFF.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defugen (moog-ff "MoogFF") 4 | (in &optional (freq 100) (gain 2) (reset 0) (mul 1) (add 0)) 5 | ((:ar 6 | (madd (multinew new 'pure-ugen in freq gain reset) mul add)) 7 | (:kr 8 | (madd (multinew new 'pure-ugen in freq gain reset) mul add))) 9 | :check-fn #'check-same-rate-as-first-input) 10 | -------------------------------------------------------------------------------- /osc/sc-osc.asd: -------------------------------------------------------------------------------- 1 | (asdf/defsystem:defsystem :sc-osc 2 | :serial t 3 | :depends-on (#:osc #:alexandria #:ieee-floats #:bordeaux-threads #:usocket 4 | #+lispworks #:cffi 5 | #+sbcl #:sb-bsd-sockets) 6 | :components ((:file "package") 7 | (:file "osc") 8 | (:file "transmit") 9 | #+ecl (:file "ecl-extension") 10 | #+lispworks (:file "lw-extension"))) 11 | -------------------------------------------------------------------------------- /ugens/TestUGens.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defugen (check-bad-values "CheckBadValues") 4 | (&optional (in 0.0) (id 0) (post 2)) 5 | ((:ar (multinew new 'ugen in id post)) 6 | (:kr (multinew new 'ugen in id post)))) 7 | 8 | (defugen (sanitize "Sanitize") 9 | (&optional (in 0.0) (replace 0.0)) 10 | ((:ar (multinew new 'ugen in replace)) 11 | (:kr (multinew new 'ugen in replace)))) 12 | -------------------------------------------------------------------------------- /ugens/SC3plugins/NHUGens.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defugen (nhhall "NHHall") 4 | (&optional (in 0.0) (rt60 1) (stereo 0.5) (lowFreq 200) (lowRatio 0.5) (hiFreq 4000) (hiRatio 0.5) (earlyDiffusion 0.5) (lateDiffusion 0.5) (modRate 0.2) (modDepth 0.3)) 5 | ((:ar (madd (multinew new 'multiout-ugen 2 (elt in 0) (elt in 1) rt60 stereo lowFreq lowRatio hiFreq hiRatio earlyDiffusion lateDiffusion modRate modDepth))))) 6 | -------------------------------------------------------------------------------- /ugens/GVerb.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defugen (g-verb "GVerb") 4 | (in &optional (roomsize 10) (revtime 3) (damping .5) (inputbw .5) (spread 15) 5 | (drylevel 1) (earlyreflevel .7) (taillevel .5) (maxroomsize 300) (mul 1) (add 0)) 6 | ((:ar (madd (multinew new 'multiout-ugen 2 in roomsize revtime damping inputbw spread 7 | drylevel earlyreflevel taillevel maxroomsize) mul add))) 8 | :check-fn (lambda (ugen) (check-n-inputs ugen 1))) 9 | -------------------------------------------------------------------------------- /ugens/quarks/redSys/RedImpulse.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defugen (red-impulse "RedImpulse") 4 | (&optional (freq 440.0) (reset .0) (mul 1.0) (add 0.0)) 5 | ((:ar (let ((osc (phasor.ar reset (/~ freq (sample-rate.ir))))) 6 | (mul-add (+~ (<~ (-~ osc (delay-1.ar osc)) 0) (impulse.ar 0)) mul add))) 7 | (:kr (let ((osc (phasor.kr reset (/~ freq (control-rate.ir))))) 8 | (mul-add (+~ (<~ (-~ osc (delay-1.kr osc)) 0) (impulse.kr 0)) mul add))))) 9 | 10 | 11 | -------------------------------------------------------------------------------- /ugens/FreeVerb.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defugen (freeverb "FreeVerb") 4 | (in &key (mix 0.33) (room 0.5) (damp 0.5) (mul 1.0) (add 0.0)) 5 | ((:ar (madd (multinew new 'pure-ugen in mix room damp) mul add)))) 6 | 7 | (defugen (freeverb2 "FreeVerb2") 8 | (in1 in2 &key (mix 0.33) (room 0.5) (damp 0.5) (mul 1.0) (add 0.0)) 9 | ((:ar (madd (multinew new 'multiout-ugen 2 in1 in2 mix room damp) mul add))) 10 | :check-fn (lambda (ugen) (check-n-inputs ugen 2))) 11 | -------------------------------------------------------------------------------- /ugens/SC3plugins/MdaUGens.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defugen (mda-piano "MdaPiano") 4 | (&optional (freq 440.0) &key (gate 1.0) (vel 100) (decay 0.8) (release 0.8) 5 | (hard 0.8) (velhard 0.8) (muffle 0.8) (velmuff 0.8) 6 | (velcurve 0.8) (stereo 0.2) (tune 0.5) (random 0.1) 7 | (stretch 0.1) (sustain 0) (mul 1) (add 0)) 8 | ((:ar 9 | (madd 10 | (multinew new 'multiout-ugen 2 freq gate vel decay release hard velhard muffle velmuff 11 | velcurve stereo tune random stretch sustain) 12 | mul add)))) 13 | -------------------------------------------------------------------------------- /ugens/SC3plugins/PitchDetection.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defugen (tartini "Tartini") 4 | (&optional (in 0.0) (threshold .93) (n 2048) (k 0) (overlap 1024) (small-cutoff .5)) 5 | ((:kr (multinew new 'multiout-ugen 2 in threshold n k overlap small-cutoff)))) 6 | 7 | (defugen (qitch "Qitch") 8 | (&optional (in 0.0) (databufnum 0.0) (ampthreshold 0.01) (algoflag 1.0) ampbufnum (minfreq 0.0) (maxfreq 2500)) 9 | ((:kr (multinew new 'multiout-ugen 2 in databufnum ampthreshold algoflag (if ampbufnum ampbufnum -1) minfreq maxfreq)))) 10 | 11 | -------------------------------------------------------------------------------- /ugens/Hilbert.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defugen (hilbert "Hilbert") (in &optional (mul 1.0) (add 0.0)) 4 | ((:ar (madd (multinew new 'multiout-ugen 2 in) 5 | mul add)))) 6 | 7 | (defun hilbert-fir.ar (in buffer) 8 | (let* ((fft (fft buffer in)) 9 | (fft (pv-phase-shift90 fft)) 10 | (delay (buf-dur.kr buffer))) 11 | (list (delay-n.ar in delay delay) (ifft.ar fft)))) 12 | 13 | (export 'hilbert-fir.ar) 14 | 15 | (defugen (freq-shift "FreqShift") 16 | (in &optional (freq 0.0) (phase 0.0) (mul 1.0) (add 0)) 17 | ((:ar (madd (multinew new 'ugen in freq phase) mul add)))) 18 | -------------------------------------------------------------------------------- /ugens/PhysicalModel.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defugen (spring "Spring") 4 | (&optional (in 0.0) (spring 1.0) (damp 0.0)) 5 | ((:ar (multinew new 'ugen in spring damp)) 6 | (:kr (multinew new 'ugen in spring damp)))) 7 | 8 | (defugen (ball "Ball") 9 | (&optional (in 0.0) (g 1.0) (damp 0.0) (friction 0.01)) 10 | ((:ar (multinew new 'ugen in g damp friction)) 11 | (:kr (multinew new 'ugen in g damp friction)))) 12 | 13 | (defugen (t-ball "TBall") 14 | (&optional (in 0.0) (g 10.0) (damp 0.0) (friction 0.01)) 15 | ((:ar (multinew new 'ugen in g damp friction)) 16 | (:kr (multinew new 'ugen in g damp friction)))) 17 | 18 | 19 | -------------------------------------------------------------------------------- /ugens/SoundIn.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defun sound-in-prim (chan-offset bus mul add) 4 | (if (not (listp bus)) (sc::madd (in.ar (sc::add chan-offset bus) 1) mul add) 5 | (if (equal bus (loop repeat (length bus) for i from (car bus) collect i)) 6 | (sc::madd (in.ar (sc::add chan-offset (car bus)) (length bus)) mul add) 7 | (sc::madd (in.ar (sc::add chan-offset bus)) mul add)))) 8 | 9 | (defun sound-in.ar (&optional (bus 0) (mul 1.0) (add 0.0)) 10 | (let ((chan-offset (num-output-buses.ir))) 11 | (sound-in-prim chan-offset bus mul add))) 12 | 13 | (defun audio-in.ar (&optional (channel 0) (mul 1.0) (add 0.0)) 14 | (let ((chan-offset (minus (num-output-buses.ir) 1))) 15 | (sound-in-prim chan-offset channel mul add))) 16 | 17 | 18 | (export 'sound-in.ar) 19 | -------------------------------------------------------------------------------- /ugens/DiskIO.lisp: -------------------------------------------------------------------------------- 1 | (in-package :sc) 2 | 3 | (defugen (disk-in "DiskIn") 4 | (chanls bufnum &optional (loop 0)) 5 | ((:ar (multinew new 'multiout-ugen chanls bufnum loop)))) 6 | 7 | (defugen (v-disk-in "VDiskIn") 8 | (chanls bufnum &optional (rate 1) (loop 0) (send-id 0)) 9 | ((:ar (multinew new 'multiout-ugen chanls bufnum rate loop send-id)))) 10 | 11 | (defugen (disk-out "DiskOut") 12 | (bufnum channels-array) 13 | ((:ar (multinew-list new 'ugen (append (list bufnum) (alexandria:ensure-list channels-array))))) 14 | :check-fn (lambda (ugen) 15 | (when (eql (rate ugen) :audio) 16 | (loop for i from 1 below (length (inputs ugen)) 17 | do (unless (eql (rate (nth i (inputs ugen))) :audio) 18 | (error (format nil "input was not audio rate : ~a" (nth i (inputs ugen))))))))) 19 | -------------------------------------------------------------------------------- /ugens/PartConv.lisp: -------------------------------------------------------------------------------- 1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2 | ;; 2025.11.20 byulparan@gmail.com 3 | ;; 4 | ;; 5 | 6 | (in-package #:sc) 7 | 8 | (defugen (part-conv "PartConv") 9 | (in fftsize irbufnum &optional (mul 1.0) (add 0.0)) 10 | ((:ar (madd (multinew new 'ugen in fftsize irbufnum) mul add)))) 11 | 12 | 13 | 14 | (defun part-conv-calc-buf-size (fftsize irbuffer) 15 | (let* ((partition-size (floor (/ fftsize 2))) 16 | (siz (frames irbuffer))) 17 | (* fftsize (ceiling (/ siz partition-size))))) 18 | 19 | 20 | (defun buffer-prepare-part-conv (buffer buf fftsize) 21 | (let* ((server (server buffer) )) 22 | (send-message server "/b_gen" (floatfy buffer) "PreparePartConv" (floatfy buf) fftsize) 23 | (sync server) 24 | buffer)) 25 | 26 | 27 | -------------------------------------------------------------------------------- /ugens/SC3plugins/DistortionPlugins.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defugen (crossover-distortion "CrossoverDistortion") 4 | (in &optional (amp .5) (smooth .5) (mul 1.0) (add 0.0)) 5 | ((:ar (madd (multinew new 'ugen in amp smooth) mul add)))) 6 | 7 | (defugen (smooth-decimator "SmoothDecimator") 8 | (in &optional (rate 44100.0) (smoothing .5) (mul 1.0) (add 0)) 9 | ((:ar (madd (multinew new 'ugen in rate smoothing) mul add)))) 10 | 11 | (defugen (decimator "Decimator") 12 | (in &optional (rate 44100.0) (bits 24) (mul 1.0) (add 0)) 13 | ((:ar (madd (multinew new 'ugen in rate bits) mul add)))) 14 | 15 | (defugen (sine-shaper "SineShaper") 16 | (in &optional (limit 1.0) (mul 1.0) (add 0)) 17 | ((:ar (madd (multinew new 'ugen in limit) mul add)))) 18 | 19 | (defugen (disintegrator "Disintegrator") 20 | (in &optional (probability 0.5) (multiplier 0.0) (mul 1.0) (add 0)) 21 | ((:ar (madd (multinew new 'ugen in probability multiplier) mul add)))) 22 | -------------------------------------------------------------------------------- /ugens/SC3plugins/DEINDUGens.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defugen (greyhole "GreyholeRaw") 4 | (in &optional (delay-time 2.0) (damp 0.0) (size 1.0) (diff 0.707) (feedback 0.9) (mod-depth 0.1) (mod-freq 2.0)) 5 | ((:ar 6 | (let ((in (alexandria:ensure-list in))) 7 | (multinew new 'multiout-ugen 2 8 | (if (alexandria:length= 1 in) 9 | in 10 | (elt in 0)) 11 | (if (alexandria:length= 1 in) 12 | in 13 | (elt in 1)) 14 | delay-time damp size diff feedback mod-depth mod-freq))))) 15 | 16 | (defugen (jpverb "JPverbRaw") 17 | (in &optional (time 1.0) (damp 0.0) (size 1.0) (early-diff 0.707) (mod-depth 0.1) (mod-freq 2.0) (low 1.0) (mid 1.0) (high 1.0) (low-cut 500.0) (high-cut 2000.0)) 18 | ((:ar 19 | (let ((in (alexandria:ensure-list in))) 20 | (multinew new 'multiout-ugen 2 21 | (if (alexandria:length= 1 in) 22 | in 23 | (elt in 0)) 24 | (if (alexandria:length= 1 in) 25 | in 26 | (elt in 1)) 27 | damp early-diff high-cut high low-cut low mod-depth mod-freq mid size time))))) 28 | -------------------------------------------------------------------------------- /ugens/Poll.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defclass poll-ugen (ugen) 4 | ()) 5 | 6 | (defugen (poll "Poll") 7 | (&optional (trig 0) (in 0.0) label (trigid -1)) 8 | ((:ar (let ((trig (alexandria:ensure-cons trig))) 9 | (setf trig (unbubble (loop for tr in trig collect (etypecase tr 10 | (number (impulse.kr tr)) 11 | (ugen tr))))) 12 | (multinew new 'poll-ugen trig in label trigid) 13 | in)) 14 | (:kr (let ((trig (alexandria:ensure-list trig))) 15 | (setf trig (unbubble (loop for tr in trig collect (etypecase tr 16 | (number (impulse.kr tr)) 17 | (ugen tr))))) 18 | (multinew new 'poll-ugen trig in label trigid) 19 | in))) 20 | :check-fn #'check-same-rate-as-first-input) 21 | 22 | (defmethod new1 ((ugen poll-ugen) &rest inputs) 23 | (destructuring-bind (trig in label trigid) 24 | inputs 25 | (unless label (setf label (format nil "UGen(~a)" in))) 26 | (setf label (map 'list #'char-code (format nil "~a" label))) 27 | (setf inputs (append (list trig in trigid (length label)) label)) 28 | (setf (inputs ugen) inputs) 29 | (add-to-synth ugen))) 30 | 31 | -------------------------------------------------------------------------------- /ugens/Splay.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defun splay-new (rate spread level center level-comp &rest in-array) 4 | (let* ((n (max 2 (length in-array))) 5 | (n1 (- n 1)) 6 | (position (+~ 7 | (*~ 8 | (-~ (*~ (loop for i from 0 to n1 collect i) 9 | (/~ 2 n1)) 10 | 1) 11 | spread) center))) 12 | (when level-comp 13 | (if (eql rate :audio) 14 | (setf level (*~ level (sqrt~ (reciprocal n)))) 15 | (setf level (/~ level n)))) 16 | (if (eql rate :audio) 17 | (*~ (sum (pan2.ar in-array position)) level) 18 | (*~ (sum (pan2.kr in-array position)) level)))) 19 | 20 | (defugen (splay "Splay") (in-array &optional (spread 1) (level 1) (center 0.0) (level-comp t)) 21 | ((:ar 22 | (declare (ignore new)) 23 | (apply #'multinew #'splay-new :audio spread level center level-comp (alexandria:ensure-list in-array))) 24 | (:kr 25 | (declare (ignore new)) 26 | (apply #'multinew #'splay-new :control spread level center level-comp (alexandria:ensure-list in-array))))) 27 | 28 | (defun splay-fill (n function &optional (spread 1) (level 1) (center 0.0) (level-comp t)) 29 | (splay.ar (dup function n) spread level center level-comp)) 30 | 31 | (export 'splay-fill) 32 | 33 | -------------------------------------------------------------------------------- /ugens/MacUGens.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defugen (mouse-x "MouseX") (&optional (minval 0) (maxval 1) (warp :linear) (lag 0.2)) 4 | ((:kr (multinew new 'ugen minval maxval (ecase warp 5 | (:linear 0) 6 | (:lin 0) 7 | (:exponential 1) 8 | (:exp 1)) 9 | lag))) 10 | :signal-range :unipolar) 11 | 12 | (defugen (mouse-y "MouseY") (&optional (minval 0) (maxval 1) (warp :linear) (lag 0.2)) 13 | ((:kr (multinew new 'ugen minval maxval (ecase warp 14 | (:linear 0) 15 | (:lin 0) 16 | (:exponential 1) 17 | (:exp 1)) 18 | lag))) 19 | :signal-range :unipolar) 20 | 21 | (defugen (mouse-button "MouseButton") (&optional (minval 0) (maxval 1) (lag 0.2)) 22 | ((:kr (multinew new 'ugen minval maxval lag))) 23 | :signal-range :unipolar) 24 | 25 | (defugen (key-state "KeyState") (&optional (keycode 0) (minval 0) (maxval 1) (lag 0.2)) 26 | ((:kr (multinew new 'ugen keycode minval maxval lag))) 27 | :signal-range :unipolar) 28 | -------------------------------------------------------------------------------- /ugens/Compander.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defugen (amplitude "Amplitude") 4 | (&optional (in 0.0) &key (attack-time 0.01) (release-time 0.01) (mul 1.0) (add 0.0)) 5 | ((:ar (madd (multinew new 'ugen in attack-time release-time) mul add)) 6 | (:kr (madd (multinew new 'ugen in attack-time release-time) mul add)))) 7 | 8 | 9 | (defugen (compander "Compander") 10 | (&optional (in 0.0) (control 0.0) (thresh 0.5) (slope-below 1.0) 11 | (slope-above 1.0) (clamp-time 0.01) (relax-time 0.1) &key 12 | (mul 1.0) (add 0.0)) 13 | ((:ar (madd (multinew new 'ugen in control thresh slope-below slope-above clamp-time 14 | relax-time) mul add)))) 15 | 16 | (defun compander-d.ar (&optional (in 0.0) (thresh 0.5) (slope-below 1.0) (slope-above 1.0) 17 | (clamp-time 0.01) (relax-time 0.01) &key (mul 1.0) (add 0.0)) 18 | (madd (compander.ar (delay-n.ar in clamp-time clamp-time) in 19 | thresh slope-below slope-above clamp-time relax-time) mul add)) 20 | 21 | (export 'compander-d.ar) 22 | 23 | (defugen (normalizer "Normalizer") 24 | (&optional (in 0.0) (level 1.0) (dur 0.01)) 25 | ((:ar (multinew new 'ugen in level dur)))) 26 | 27 | (defugen (limiter "Limiter") 28 | (&optional (in 0.0) (level 1.0) (dur 0.01)) 29 | ((:ar (multinew new 'ugen in level dur)))) 30 | 31 | -------------------------------------------------------------------------------- /ugens/IEnvGen.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defun as-array-for-interpolation (env) 4 | "Convert ENV into an array in a format suitable for i-env-gen." 5 | (with-slots (levels times curve-number curve-value) env 6 | (let* ((size (length times)) 7 | (contents (append (list 8 | 0 ;; Env offset (not implemented in cl-collider) 9 | (elt levels 0) 10 | size 11 | (reduce #'+ times)) 12 | (loop :for i :from 0 :below size 13 | :append (list (elt times i) 14 | (nth-wrap i curve-number) 15 | (nth-wrap i curve-value) 16 | (elt levels (1+ i))))))) 17 | (mapcar (lambda (list) 18 | (coerce list 'vector)) 19 | (flop contents))))) 20 | 21 | (defugen (i-env-gen "IEnvGen") 22 | (envelope index &optional (mul 1.0) (add 0.0)) 23 | ((:ar (madd (unbubble (mapcar #'process-env (multinew new 'ugen index 24 | (as-array-for-interpolation envelope)))) mul add)) 25 | (:kr (madd (unbubble (mapcar #'process-env (multinew new 'ugen index 26 | (as-array-for-interpolation envelope)))) mul add)))) 27 | -------------------------------------------------------------------------------- /slynk-extensions.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-collider) 2 | 3 | ;; make sly show the synthdef's argument list for (synth ...) 4 | (defmethod slynk::compute-enriched-decoded-arglist ((operator-form (eql 'synth)) 5 | argument-forms) 6 | (let* ((fst (car argument-forms)) 7 | (controls (unless (typep fst 'slynk::arglist-dummy) 8 | (synthdef-metadata (if (and (listp fst) 9 | (eql 'quote (car fst))) 10 | (cadr fst) 11 | fst) 12 | :controls)))) 13 | (if controls 14 | (loop 15 | :for ctl :in controls 16 | :if (atom ctl) 17 | :collect ctl :into req 18 | :if (listp ctl) 19 | :collect (slynk::make-keyword-arg 20 | (alexandria:make-keyword (car ctl)) 21 | (car ctl) 22 | (cadr ctl)) 23 | :into key 24 | :finally 25 | (return 26 | (slynk::make-arglist 27 | :required-args (append (list fst) req) 28 | :key-p t 29 | :keyword-args (append 30 | key 31 | (slynk::keywords-of-operator operator-form))))) 32 | (call-next-method)))) 33 | -------------------------------------------------------------------------------- /swank-extensions.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-collider) 2 | 3 | ;; make slime show the synthdef's argument list for (synth ...) 4 | (defmethod swank::compute-enriched-decoded-arglist ((operator-form (eql 'synth)) 5 | argument-forms) 6 | (let* ((fst (car argument-forms)) 7 | (controls (unless (typep fst 'swank::arglist-dummy) 8 | (synthdef-metadata (if (and (listp fst) 9 | (eql 'quote (car fst))) 10 | (cadr fst) 11 | fst) 12 | :controls)))) 13 | (if controls 14 | (loop 15 | :for ctl :in controls 16 | :if (atom ctl) 17 | :collect ctl :into req 18 | :if (listp ctl) 19 | :collect (swank::make-keyword-arg 20 | (alexandria:make-keyword (car ctl)) 21 | (car ctl) 22 | (cadr ctl)) 23 | :into key 24 | :finally 25 | (return 26 | (swank::make-arglist 27 | :required-args (append (list fst) req) 28 | :key-p t 29 | :keyword-args (append 30 | key 31 | (swank::keywords-of-operator operator-form))))) 32 | (call-next-method)))) 33 | -------------------------------------------------------------------------------- /ugens/SC3plugins/MCLDUGens.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-collider) 2 | 3 | 4 | ;; ================================================================================ 5 | ;; MCLDOscUGens 6 | ;; ================================================================================ 7 | 8 | (defugen (saw-dpw "SawDPW") 9 | (&optional (freq 440.0) (iphase 0.0) (mul 1.0) (add 0.0)) 10 | ((:ar (madd (multinew new 'ugen freq iphase) mul add)) 11 | (:kr (madd (multinew new 'ugen freq iphase) mul add)))) 12 | 13 | 14 | 15 | ;; ================================================================================ 16 | ;; MCLDFFTUGens 17 | ;; ================================================================================ 18 | 19 | (def-pv-chain-ugen (pv-whiten "PV_Whiten") ;; from MCLDUgens 20 | (buffer track-bufnum &optional (relax-time 2.0) (floor 0.1) (smear 0.0) (bin-downsample 0.0)) 21 | (multinew new 'pv-chain-ugen buffer track-bufnum relax-time floor smear bin-downsample)) 22 | 23 | 24 | 25 | 26 | ;; ================================================================================ 27 | ;; MCLDBufferUGens 28 | ;; ================================================================================ 29 | 30 | ;; ListTrig 31 | 32 | ;; ListTrig2 33 | 34 | ;; GaussClass 35 | 36 | ;; BufMax 37 | 38 | ;; BufMin 39 | 40 | (defugen (array-max "ArrayMax") (array) 41 | ((:ar (multinew-list new 'multiout-ugen (append (list 2) array))) 42 | (:kr (multinew-list new 'multiout-ugen (append (list 2) array))))) 43 | 44 | (defugen (array-min "ArrayMin") (array) 45 | ((:ar (multinew-list new 'multiout-ugen (append (list 2) array))) 46 | (:kr (multinew-list new 'multiout-ugen (append (list 2) array))))) 47 | -------------------------------------------------------------------------------- /ugens/InfoUGens.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defugen (info-ugen-base "InfoUGenBase") () 4 | ((:ir (multinew new 'ugen)))) 5 | 6 | (defugen (buf-info-ugen-base "BufInfoUGenBase") (bufnum) 7 | ((:kr (multinew new 'ugen bufnum)) 8 | (:ir (multinew new 'ugen bufnum)))) 9 | 10 | (defmacro def-info-ugen-base (name) 11 | `(defugen (,(car name) ,(second name)) 12 | () 13 | ((:ir (multinew new 'ugen))))) 14 | 15 | (defmacro def-buf-info-ugen-base (name) 16 | `(defugen (,(car name) ,(second name)) 17 | (bufnum) 18 | ((:kr (multinew new 'ugen bufnum)) 19 | (:ir (multinew new 'ugen bufnum))))) 20 | 21 | (defugen (num-running-synths "NumRunningSynths") () 22 | ((:kr (multinew new 'ugen)))) 23 | 24 | (def-info-ugen-base (sample-rate "SampleRate")) 25 | (def-info-ugen-base (sample-dur "SampleDur")) 26 | (def-info-ugen-base (radians-per-sample "RadiansPerSample")) 27 | (def-info-ugen-base (control-rate "ControlRate")) 28 | (def-info-ugen-base (control-dur "ControlDur")) 29 | (def-info-ugen-base (subsample-offset "SubsampleOffset")) 30 | (def-info-ugen-base (num-output-buses "NumOutputBuses")) 31 | (def-info-ugen-base (num-input-buses "NumInputBuses")) 32 | (def-info-ugen-base (num-audio-buses "NumAudioBuses")) 33 | (def-info-ugen-base (num-control-buses "NumControlBuses")) 34 | (def-info-ugen-base (num-buffers "NumBuffers")) 35 | 36 | (def-buf-info-ugen-base (buf-sample-rate "BufSampleRate")) 37 | (def-buf-info-ugen-base (buf-rate-scale "BufRateScale")) 38 | (def-buf-info-ugen-base (buf-frames "BufFrames")) 39 | (def-buf-info-ugen-base (buf-samples "BufSamples")) 40 | (def-buf-info-ugen-base (buf-dur "BufDur")) 41 | (def-buf-info-ugen-base (buf-channels "BufChannels")) 42 | 43 | (defun min-nyquist (ugen) 44 | (min~ ugen (mul (sample-rate.ir) 0.5))) 45 | -------------------------------------------------------------------------------- /ugens/Gendyn.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defugen (gendy1 "Gendy1") 4 | (&optional (amp-dist 1) (dur-dist 1) (ad-param 1.0) (dd-param 1.0) 5 | (min-freq 440.0) (max-freq 660.0) (amp-scale 0.5) (dur-scale 0.5) 6 | (init-cps 12) knum (mul 1.0) (add 1.0)) 7 | ((:ar (madd (multinew new 'ugen amp-dist dur-dist ad-param dd-param min-freq 8 | max-freq amp-scale dur-scale init-cps (if knum knum init-cps)) 9 | mul add)) 10 | (:kr (madd (multinew new 'ugen amp-dist dur-dist ad-param dd-param min-freq 11 | max-freq amp-scale dur-scale init-cps (if knum knum init-cps)) 12 | mul add)))) 13 | 14 | (defugen (gendy2 "Gendy2") 15 | (&optional (amp-dist 1) (dur-dist 1) (ad-param 1.0) (dd-param 1.0) 16 | (min-freq 440.0) (max-freq 660.0) (amp-scale 0.5) (dur-scale 0.5) 17 | (init-cps 12) knum (a 1.17) (c 0.31) (mul 1.0) (add 1.0)) 18 | ((:ar (madd (multinew new 'ugen amp-dist dur-dist ad-param dd-param min-freq 19 | max-freq amp-scale dur-scale init-cps (if knum knum init-cps) a c) 20 | mul add)) 21 | (:kr (madd (multinew new 'ugen amp-dist dur-dist ad-param dd-param min-freq 22 | max-freq amp-scale dur-scale init-cps (if knum knum init-cps) a c) 23 | mul add)))) 24 | 25 | (defugen (gendy3 "Gendy3") 26 | (&optional (amp-dist 1) (dur-dist 1) (ad-param 1.0) (dd-param 1.0) 27 | (freq 440.0) (amp-scale 0.5) (dur-scale 0.5) 28 | (init-cps 12) knum (mul 1.0) (add 1.0)) 29 | ((:ar (madd (multinew new 'ugen amp-dist dur-dist ad-param dd-param freq 30 | amp-scale dur-scale init-cps (if knum knum init-cps)) 31 | mul add)) 32 | (:kr (madd (multinew new 'ugen amp-dist dur-dist ad-param dd-param freq 33 | amp-scale dur-scale init-cps (if knum knum init-cps)) 34 | mul add)))) 35 | 36 | -------------------------------------------------------------------------------- /ugens/MachineListening.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defugen (beat-track "BeatTrack") 4 | (chain &optional (lock 0)) 5 | ((:kr (multinew new 'multiout-ugen 4 chain lock)))) 6 | 7 | (defugen (loudness "Loudness") 8 | (chain &optional (s-mask 0.25) (t-mask 1)) 9 | ((:kr (multinew new 'ugen chain s-mask t-mask)))) 10 | 11 | (defugen (onsets "Onsets") 12 | (chain &optional (threshold 0.5) (odf-type :rcomplex) (relax-time 1) 13 | (floor 0.1) (min-gap 10) (median-span 11) (wh-type 1) (raw-odf 0)) 14 | ((:kr 15 | (let* ((odf-types '(:power :magsum :complex :rcomplex :phase :wphase :mkl)) 16 | (odf-type (if (and (integerp odf-type) 17 | (>= odf-type 0) 18 | (< odf-type (length odf-types))) 19 | odf-type 20 | (position odf-type odf-types)))) 21 | (multinew new 'ugen 22 | chain threshold odf-type relax-time floor min-gap median-span 23 | wh-type raw-odf))))) 24 | 25 | (defugen (keytrack "KeyTrack") 26 | (chain &optional (key-decay 2.0) (chroma-leak 0.5)) 27 | ((:kr (multinew new 'ugen chain key-decay chroma-leak)))) 28 | 29 | (defugen (mfcc "MFCC") 30 | (chain &optional (numcoeff 13)) 31 | ((:kr (multinew new 'multiout-ugen numcoeff chain numcoeff)))) 32 | 33 | (defugen (beat-track2 "BeatTrack2") 34 | (bus-index num-features 35 | &optional (window-size 2.0) (phase-accuracy 0.02) (lock 0) (weighting-scheme -2.5)) 36 | ((:kr 37 | (multinew new 'multiout-ugen 6 38 | bus-index num-features window-size phase-accuracy lock weighting-scheme)))) 39 | 40 | (defugen (spec-flatness "SpecFlatness") (buffer) 41 | ((:kr (multinew new 'ugen buffer)))) 42 | 43 | (defugen (spec-pcile "SpecPcile") 44 | (buffer &optional (fraction 0.5) (interpolate 0)) 45 | ((:kr (multinew new 'ugen buffer fraction interpolate)))) 46 | 47 | (defugen (spec-centroid "SpecCentroid") (buffer) 48 | ((:kr (multinew new 'ugen buffer)))) 49 | -------------------------------------------------------------------------------- /LICENCE: -------------------------------------------------------------------------------- 1 | cl-collider software and associated documentation are in the public 2 | domain: 3 | 4 | Authors dedicate this work to public domain, for the benefit of the 5 | public at large and to the detriment of the authors' heirs and 6 | successors. Authors intends this dedication to be an overt act of 7 | relinquishment in perpetuity of all present and future rights under 8 | copyright law, whether vested or contingent, in the work. Authors 9 | understands that such relinquishment of all rights includes the 10 | relinquishment of all rights to enforce (by lawsuit or otherwise) 11 | those copyrights in the work. 12 | 13 | Authors recognize that, once placed in the public domain, the work 14 | may be freely reproduced, distributed, transmitted, used, modified, 15 | built upon, or otherwise exploited by anyone for any purpose, 16 | commercial or non-commercial, and in any way, including by methods 17 | that have not yet been invented or conceived. 18 | 19 | In those legislations where public domain dedications are not 20 | recognized or possible, cl-collider is distributed under the following 21 | terms and conditions: 22 | 23 | Permission is hereby granted, free of charge, to any person 24 | obtaining a copy of this software and associated documentation files 25 | (the "Software"), to deal in the Software without restriction, 26 | including without limitation the rights to use, copy, modify, merge, 27 | publish, distribute, sublicense, and/or sell copies of the Software, 28 | and to permit persons to whom the Software is furnished to do so, 29 | subject to the following conditions: 30 | 31 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 32 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 33 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 34 | IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY 35 | CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 36 | TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 37 | SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 38 | -------------------------------------------------------------------------------- /ugens/GrainUGens.lisp: -------------------------------------------------------------------------------- 1 | (in-package :sc) 2 | 3 | (defugen (grain-sin "GrainSin") (&optional (numchan 1) (trig 0) (dur 1) (freq 440) 4 | (pan 0.0) (envbufnum -1) (max-grains 512) 5 | &key (mul 1.0) (add 0.0)) 6 | ((:ar (madd (multinew new 'multiout-ugen numchan trig dur freq pan envbufnum max-grains) 7 | mul add)))) 8 | 9 | (defugen (grain-fm "GrainFM") (&optional (numchan 1) (trig 0) (dur 1) (car-freq 440) 10 | (mod-freq 200) (index 1) (pan 0.0) (envbufnum -1) (max-grains 512) 11 | &key (mul 1.0) (add 0.0)) 12 | ((:ar (madd (multinew new 'multiout-ugen numchan trig dur car-freq mod-freq index pan envbufnum max-grains) 13 | mul add)))) 14 | 15 | 16 | (defugen (grain-buf "GrainBuf") (&optional (numchan 1) (trig 0) (dur 1) sndbuf (rate 1) (pos 0) (interp 2) 17 | (pan 0.0) (envbufnum -1) (max-grains 512) 18 | &key (mul 1.0) (add 0.0)) 19 | ((:ar (madd (multinew new 'multiout-ugen numchan trig dur sndbuf rate pos interp pan envbufnum max-grains) 20 | mul add)))) 21 | 22 | 23 | 24 | (defugen (grain-in "GrainIn") (&optional (numchan 1) (trig 0) (dur 1) in 25 | (pan 0.0) (envbufnum -1) (max-grains 512) 26 | &key (mul 1.0) (add 0.0)) 27 | ((:ar (madd (multinew new 'multiout-ugen numchan trig dur in pan envbufnum max-grains) 28 | mul add)))) 29 | 30 | (defugen (warp1 "Warp1") (&optional (numchan 1) (bufnum 0) (pointer 0) (freq-scale 1) (window-size 0.2) 31 | (envbufnum -1) (overlaps 8) (window-rand-ratio 0.0) (interp 1) 32 | &key (mul 1.0) (add 0.0)) 33 | ((:ar (madd (multinew new 'multiout-ugen numchan bufnum pointer freq-scale window-size envbufnum overlaps 34 | window-rand-ratio interp) 35 | mul add)))) 36 | 37 | (defugen (warpz "WarpZ") (&optional (numchan 1) (bufnum 0) (pointer 0) (freq-scale 1) 38 | (window-size 0.2) (envbufnum -1) (overlaps 8) (window-rand-ratio 0.0) 39 | (interp 1) (zero-search 0) (zero-start 0) (mul 1) (add 0)) 40 | ((:ar (madd (multinew new 'multiout-ugen numchan bufnum pointer freq-scale 41 | window-size envbufnum overlaps window-rand-ratio interp 42 | zero-search zero-start) 43 | mul add)))) 44 | 45 | -------------------------------------------------------------------------------- /server-options.lisp: -------------------------------------------------------------------------------- 1 | (in-package :sc) 2 | 3 | (defvar *sc-plugin-paths*) 4 | 5 | (defstruct server-options 6 | (num-control-bus 16384) 7 | (num-audio-bus 1024) 8 | (num-input-bus 8) 9 | (num-output-bus 8) 10 | (block-size 64) 11 | (hardware-buffer-size 0) 12 | (hardware-samplerate 0) 13 | (num-sample-buffers 1024) 14 | (max-num-nodes 1024) 15 | (max-num-synthdefs 1024) 16 | (realtime-mem-size 8192) 17 | (num-wire-buffers 64) 18 | (num-random-seeds 64) 19 | (load-synthdefs-p 1) 20 | (publish-to-rendezvous-p 1) 21 | (max-logins 64) 22 | (verbosity 0) 23 | (ugen-plugins-path (mapcar #'full-pathname *sc-plugin-paths*)) 24 | (device nil) 25 | (input-stream-enabled nil) 26 | (output-stream-enabled nil)) 27 | 28 | (defun build-server-options (server-options) 29 | ;; If the hardware buffer size is 0, do not apply the -Z option 30 | (when (zerop (server-options-hardware-buffer-size server-options)) 31 | (setf (server-options-hardware-buffer-size server-options) nil)) 32 | (reduce #'append 33 | (mapcar (lambda (pair) 34 | (let ((param-name (first pair)) 35 | (param-value (funcall (second pair) server-options))) 36 | (when param-value 37 | (list param-name 38 | (if (stringp param-value) 39 | param-value 40 | (write-to-string param-value)))))) 41 | (list '("-c" server-options-num-control-bus) 42 | '("-a" server-options-num-audio-bus) 43 | '("-i" server-options-num-input-bus) 44 | '("-o" server-options-num-output-bus) 45 | '("-z" server-options-block-size) 46 | '("-Z" server-options-hardware-buffer-size) 47 | '("-S" server-options-hardware-samplerate) 48 | '("-b" server-options-num-sample-buffers) 49 | '("-n" server-options-max-num-nodes) 50 | '("-d" server-options-max-num-synthdefs) 51 | '("-m" server-options-realtime-mem-size) 52 | '("-w" server-options-num-wire-buffers) 53 | '("-r" server-options-num-random-seeds) 54 | '("-D" server-options-load-synthdefs-p) 55 | '("-R" server-options-publish-to-rendezvous-p) 56 | '("-l" server-options-max-logins) 57 | '("-V" server-options-verbosity) 58 | '("-H" server-options-device) 59 | '("-I" server-options-input-stream-enabled) 60 | '("-O" server-options-output-stream-enabled))) 61 | :initial-value (let* ((paths (server-options-ugen-plugins-path server-options))) 62 | (when paths 63 | (list "-U" (format nil 64 | #-windows "~{~a~^:~}" 65 | #+windows "~{~a~^;~}" 66 | paths)))))) 67 | -------------------------------------------------------------------------------- /id-map.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | ;;; ---id map ------------------------------------ 4 | 5 | (defstruct id-map 6 | (vector (make-array 1 :initial-element nil)) 7 | (free 0) 8 | (lock (bt:make-recursive-lock))) 9 | 10 | (defun id-map-grow (id-map) 11 | (let* ((old-vector (id-map-vector id-map)) 12 | (old-size (length old-vector)) 13 | (new-size (+ old-size old-size)) 14 | (new-vector (make-array new-size))) 15 | (declare (fixnum old-size new-size)) 16 | (dotimes (i old-size) 17 | (setf (svref new-vector i) (svref old-vector i))) 18 | (let* ((limit (1- new-size))) 19 | (declare (fixnum limit)) 20 | (do* ((i old-size (1+ i))) 21 | ((= i limit) (setf (svref new-vector i) nil)) 22 | (declare (fixnum i)) 23 | (setf (svref new-vector i) (the fixnum (1+ i))))) 24 | (setf (id-map-vector id-map) new-vector 25 | (id-map-free id-map) old-size))) 26 | 27 | (defun assign-id-map-id (id-map object) 28 | (if (or (null object) (typep object 'fixnum)) (error "OBJECT must not be FIXNUM or NIL")) 29 | (bt:with-recursive-lock-held ((id-map-lock id-map)) 30 | (let* ((free (or (id-map-free id-map) (id-map-grow id-map))) 31 | (vector (id-map-vector id-map)) 32 | (newfree (svref vector free))) 33 | (setf (id-map-free id-map) newfree 34 | (svref vector free) object) 35 | free))) 36 | 37 | (defun id-map-object (id-map id) 38 | (let* ((object (bt:with-recursive-lock-held ((id-map-lock id-map)) 39 | (svref (id-map-vector id-map) id)))) 40 | (if (or (null object) (typep object 'fixnum)) 41 | (error "Invalid index ~d for ~s" id id-map) 42 | object))) 43 | 44 | (defun id-map-free-object (id-map id) 45 | (bt:with-recursive-lock-held ((id-map-lock id-map)) 46 | (let* ((vector (id-map-vector id-map)) 47 | (object (svref vector id))) 48 | (if (or (null object) (typep object 'fixnum)) 49 | (error "Invalid index ~d for ~s" id id-map)) 50 | (setf (svref vector id) (id-map-free id-map) 51 | (id-map-free id-map) id) 52 | object))) 53 | 54 | (defun id-map-modify-object (id-map id old-value new-value) 55 | (bt:with-recursive-lock-held ((id-map-lock id-map)) 56 | (let* ((vector (id-map-vector id-map)) 57 | (object (svref vector id))) 58 | (if (or (null object) (typep object 'fixnum)) 59 | (error "Invalid index ~d for ~s" id id-map)) 60 | (if (eq object old-value) 61 | (setf (svref vector id) new-value))))) 62 | -------------------------------------------------------------------------------- /bus.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defclass bus () 4 | ((busnum :initarg :busnum :initform nil :accessor busnum) 5 | (type :initarg :type :initform :audio) 6 | (chanls :initarg :chanls :initform nil :accessor chanls) 7 | (server :initarg :server :initform nil :accessor server))) 8 | 9 | (defmethod print-object ((self bus) stream) 10 | (format stream "#<~s :type ~s :server ~s :busnum ~s :channels ~s>" 11 | 'bus (slot-value self 'type) (server self) (busnum self) (chanls self))) 12 | 13 | (defmethod floatfy ((bus bus)) 14 | (floatfy (busnum bus))) 15 | 16 | (defun get-next-bus (server &optional (type :audio) (channels 1) busnum) 17 | (assert (member type '(:audio :control)) (type)) 18 | (labels ((find-consecutive-nil (&optional (type :audio) (channels 1) (start 0)) 19 | (let* ((buses (if (eq type :audio) 20 | (audio-buses server) 21 | (control-buses server))) 22 | (pos (position nil buses :start start))) 23 | (if (loop :for i :upto (1- channels) 24 | :do (when (not (null (elt buses (+ pos i)))) 25 | (return t))) 26 | (find-consecutive-nil type channels (1+ pos)) 27 | pos)))) 28 | (bt:with-lock-held ((server-lock server)) 29 | (let* ((busnum (or busnum (find-consecutive-nil type channels))) 30 | (bus-obj (make-instance 'bus :type type :busnum busnum :server server :chanls channels))) 31 | (loop :for i :upto (1- channels) 32 | :do (setf (elt (if (eq type :audio) 33 | (audio-buses server) 34 | (control-buses server)) 35 | (+ busnum i)) 36 | bus-obj)) 37 | bus-obj)))) 38 | 39 | (defun bus-alloc (type &key (chanls 1) busnum (server *s*)) 40 | (assert (member type '(:audio :control)) (type)) 41 | (get-next-bus server type chanls busnum)) 42 | 43 | (defun bus-audio (&key (chanls 1) busnum (server *s*)) 44 | (bus-alloc :audio :chanls chanls :busnum busnum :server server)) 45 | 46 | (defun bus-control (&key (chanls 1) busnum (server *s*)) 47 | (bus-alloc :control :chanls chanls :busnum busnum :server server)) 48 | 49 | (defun bus-free (bus &key (server *s*)) 50 | (let ((type (slot-value bus 'type))) 51 | (bt:with-lock-held ((server-lock server)) 52 | (loop :for i :upto (1- (chanls bus)) 53 | :do 54 | (setf (elt (if (eq type :audio) 55 | (audio-buses server) 56 | (control-buses server)) 57 | (+ i (busnum bus))) 58 | nil))))) 59 | 60 | (defun bus-string (bus) 61 | "Make a string representing the bus that the server can understand." 62 | (with-slots (type busnum) bus 63 | (format nil "~a~a" 64 | (if (eq :audio type) 65 | "a" 66 | "c") 67 | busnum))) 68 | -------------------------------------------------------------------------------- /ugens/BEQSuite.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defun b-pass-sc (low-hi freq rq) 4 | (let* ((w0 (*~ 2 pi freq (sample-dur.ir))) 5 | (cos-w0 (cos~ w0)) 6 | (i (funcall (if (eq :low low-hi) #'-~ #'+~) 1 cos-w0)) 7 | (alpha (*~ (sin~ w0) 0.5 (sqrt~ rq))) 8 | (b0rz (/~ 1 (+~ 1 alpha))) 9 | (a0 (*~ i 0.5 b0rz)) 10 | (a1 (*~ (if (eq :low low-hi) i (*~ -1 i)) b0rz)) 11 | (b1 (*~ cos-w0 2 b0rz)) 12 | (b2 (*~ (-~ 1 alpha) (*~ -1 b0rz)))) 13 | (list a0 a1 a0 b1 b2))) 14 | 15 | (defun b-pass4-new (low-hi new in freq rq) 16 | (declare (ignorable new)) 17 | (let ((coefs (b-pass-sc low-hi freq rq))) 18 | (apply #'multinew #'sos.ar (apply #'sos.ar in coefs) coefs))) 19 | 20 | (defugen (b-lowpass "BLowPass") 21 | (&optional (in 0.0) (freq 1200.0) (rq 1.0) (mul 1.0) (add 0.0)) 22 | ((:ar (madd (multinew new 'pure-ugen in freq rq) mul add))) 23 | :check-fn #'check-same-rate-as-first-input) 24 | 25 | (defugen (b-hipass "BHiPass") 26 | (&optional (in 0.0) (freq 1200.0) (rq 1.0) (mul 1.0) (add 0.0)) 27 | ((:ar (madd (multinew new 'pure-ugen in freq rq) mul add))) 28 | :check-fn #'check-same-rate-as-first-input) 29 | 30 | 31 | (defugen (b-allpass "BAllPass") 32 | (&optional (in 0.0) (freq 1200.0) (rq 1.0) (mul 1.0) (add 0.0)) 33 | ((:ar (madd (multinew new 'pure-ugen in freq rq) mul add))) 34 | :check-fn #'check-same-rate-as-first-input) 35 | 36 | 37 | (defugen (b-bandpass "BBandPass") 38 | (&optional (in 0.0) (freq 1200.0) (bw 1.0) (mul 1.0) (add 0.0)) 39 | ((:ar (madd (multinew new 'pure-ugen in freq bw) mul add))) 40 | :check-fn #'check-same-rate-as-first-input) 41 | 42 | 43 | (defugen (b-bandstop "BBandStop") 44 | (&optional (in 0.0) (freq 1200.0) (bw 1.0) (mul 1.0) (add 0.0)) 45 | ((:ar (madd (multinew new 'pure-ugen in freq bw) mul add))) 46 | :check-fn #'check-same-rate-as-first-input) 47 | 48 | 49 | (defugen (b-peak-eq "BPeakEQ") 50 | (&optional (in 0.0) (freq 1200.0) (rq 1.0) (db 0.0) (mul 1.0) (add 0.0)) 51 | ((:ar (madd (multinew new 'pure-ugen in freq rq db) mul add))) 52 | :check-fn #'check-same-rate-as-first-input) 53 | 54 | (defugen (b-lowshelf "BLowShelf") 55 | (&optional (in 0.0) (freq 1200.0) (rq 1.0) (db 0.0) (mul 1.0) (add 0.0)) 56 | ((:ar (madd (multinew new 'pure-ugen in freq rq db) mul add))) 57 | :check-fn #'check-same-rate-as-first-input) 58 | 59 | 60 | (defugen (b-hishelf "BHiShelf") 61 | (&optional (in 0.0) (freq 1200.0) (rq 1.0) (db 0.0) (mul 1.0) (add 0.0)) 62 | ((:ar (madd (multinew new 'pure-ugen in freq rq db) mul add))) 63 | :check-fn #'check-same-rate-as-first-input) 64 | 65 | 66 | (defugen (b-lowpass4 "BLowPass4") 67 | (&optional (in 0.0) (freq 1200.0) (rq 1.0) (mul 1.0) (add 0.0)) 68 | ((:ar (madd (multinew #'b-pass4-new :low new in freq rq) mul add))) 69 | :check-fn #'check-same-rate-as-first-input) 70 | 71 | (defugen (b-hipass4 "BHiPass4") 72 | (&optional (in 0.0) (freq 1200.0) (rq 1.0) (mul 1.0) (add 0.0)) 73 | ((:ar (madd (multinew #'b-pass4-new :hi new in freq rq) mul add))) 74 | :check-fn #'check-same-rate-as-first-input) 75 | -------------------------------------------------------------------------------- /cl-collider.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem #:cl-collider 2 | :name "cl-collider" 3 | :author "Park Sungmin. byulparan@gmail.com" 4 | :description "SuperCollider client for Common Lisp" 5 | :licence "Public Domain / 0-clause MIT" 6 | :version "2025.8.21" 7 | :depends-on (#:sc-osc 8 | #:alexandria 9 | #:cffi 10 | #:bordeaux-threads 11 | #:pileup 12 | #:flexi-streams 13 | #:named-readtables 14 | #:cl-ppcre 15 | (:feature (:not :darwin) #:precise-time)) 16 | :serial t 17 | :components ((:file "package") 18 | #-ccl (:file "id-map") 19 | (:file "util") 20 | ;; swank-extensions.lisp/slynk-extensions.lisp conditionally loaded at the end of util.lisp 21 | (:file "server-options") 22 | (:file "scheduler") 23 | (:file "server") 24 | (:file "buffer") 25 | (:file "bus") 26 | (:file "ugen") 27 | (:file "synthdef") 28 | (:file "operators") 29 | (:file "ugens/BEQSuite") 30 | (:file "ugens/BufIO") 31 | (:file "ugens/Chaos") 32 | (:file "ugens/Compander") 33 | (:file "ugens/Delays") 34 | (:file "ugens/Demand") 35 | (:file "ugens/DiskIO") 36 | (:file "ugens/EnvGen") 37 | (:file "ugens/FFT") 38 | (:file "ugens/FFTUnpacking") 39 | (:file "ugens/FSinOsc") 40 | (:file "ugens/Filter") 41 | (:file "ugens/FreeVerb") 42 | (:file "ugens/GVerb") 43 | (:file "ugens/Gendyn") 44 | (:file "ugens/GrainUGens") 45 | (:file "ugens/Hilbert") 46 | (:file "ugens/IEnvGen") 47 | (:file "ugens/InOut") 48 | (:file "ugens/InfoUGens") 49 | (:file "ugens/Line") 50 | (:file "ugens/MacUGens") 51 | (:file "ugens/MachineListening") 52 | (:file "ugens/MoogFF") 53 | (:file "ugens/Noise") 54 | (:file "ugens/Osc") 55 | (:file "ugens/PSinGrain") 56 | (:file "ugens/Pan") 57 | (:file "ugens/PartConv") 58 | (:file "ugens/PhysicalModel") 59 | (:file "ugens/PitchShift") 60 | (:file "ugens/Pluck") 61 | (:file "ugens/Poll") 62 | (:file "ugens/SoundIn") 63 | (:file "ugens/Splay") 64 | (:file "ugens/TestUGens") 65 | (:file "ugens/Trig") 66 | (:file "ugens/SC3plugins/MCLDUGens") 67 | (:file "ugens/SC3plugins/BhobUGens") 68 | (:file "ugens/SC3plugins/DistortionPlugins") 69 | (:file "ugens/SC3plugins/JoshUGens") 70 | (:file "ugens/SC3plugins/LadspaUGen") 71 | (:file "ugens/SC3plugins/MdaUGens") 72 | (:file "ugens/SC3plugins/PitchDetection") 73 | (:file "ugens/SC3plugins/SLUGens") 74 | (:file "ugens/SC3plugins/DEINDUGens") 75 | (:file "ugens/SC3plugins/NHUGens") 76 | (:file "ugens/SC3plugins/TJUGens") 77 | (:file "ugens/quarks/miSCellaneous_lib/WaveFolding") 78 | (:file "ugens/quarks/redSys/RedImpulse") 79 | (:file "ugens/Extensions/mi-UGens") 80 | (:file "ugens/Extensions/f0plugins") 81 | (:file "ugens/Extensions/DynGen") 82 | (:file "ugens/Extensions/PortedPlugins"))) 83 | -------------------------------------------------------------------------------- /ugens/Extensions/DynGen.lisp: -------------------------------------------------------------------------------- 1 | ;; https://github.com/capital-G/DynGen 2 | 3 | (in-package :sc) 4 | 5 | (export '(list-all-dyn-gen def-dyn-gen dyn-gen.ar dyn-gen-rt.ar)) 6 | 7 | 8 | (defvar *dyn-gen-table* (make-hash-table)) 9 | 10 | (defun list-all-dyn-gen () 11 | "Return all dyn-gen objects" 12 | (alexandria:hash-table-values *dyn-gen-table*)) 13 | 14 | 15 | (defstruct (dyn-gen 16 | (:constructor %make-dyn-gen (name hash code))) 17 | name hash code) 18 | 19 | 20 | (defun name-hash (name) 21 | (flet ((hash (name) 22 | (mod (sxhash name) (expt 2 20)))) 23 | (let* ((h (hash name))) 24 | (loop for n in (remove name (alexandria:hash-table-keys *dyn-gen-table*)) 25 | when (= h (hash n)) 26 | do (error "Conflict hash key ~a and ~a." name n)) 27 | h))) 28 | 29 | 30 | (defun def-dyn-gen (name code) 31 | "In order to run a DynGen script on the server it is necessary to first register it on the server under a given name, similar to a SynthDef. 32 | If the code for an already existing name gets updated, all running instances of this code will also be updated. This allows to live-code DynGen scripts." 33 | (assert (and (boot-p *s*) (is-local-p *s*))) 34 | (let* ((hash (name-hash name)) 35 | (dyn-gen (%make-dyn-gen name hash code))) 36 | (setf (gethash name *dyn-gen-table*) dyn-gen) 37 | (uiop:with-temporary-file (:stream stream 38 | :pathname p) 39 | (format stream "~a" code) 40 | (close stream) 41 | (send-message *s* "/cmd" "dyngenadd" (floatfy hash) (namestring p)) 42 | (sync)) 43 | dyn-gen)) 44 | 45 | 46 | 47 | (defun meta-dyn-gen (ugen-name num-outputs script realtime inputs) 48 | (let* ((hash (cond ((dyn-gen-p script) (dyn-gen-hash script)) 49 | (t (name-hash script))))) 50 | (apply #'ugen-new ugen-name :audio 'multiout-ugen #'identity :bipolar 51 | num-outputs hash realtime 52 | (mapcar (lambda (in) (if (eql :audio (rate in)) in 53 | (k2a.ar in))) 54 | inputs)))) 55 | 56 | 57 | (defun dyn-gen.ar (num-outputs script &rest inputs) 58 | "This UGen evaluates EEL2 (expression evaluation library/realtime compiler) code in a VM which runs on the server. This allows to write DSP code on the fly and perform single sample operations. 59 | 60 | The code has to be registered using DynGenDef and follows a similar approach to SynthDef by registering a resource (code) under a given name. This also allows to update the evaluated code on the fly. 61 | 62 | Each script can expose multiple outputs and the output for each channel can be written to via the variable out0, out1, ... When the script gets evaluated through DynGen it is also necessary to tell how many outputs of the script should be exposed." 63 | (meta-dyn-gen "DynGen" num-outputs script 0.0 inputs)) 64 | 65 | 66 | 67 | (defun dyn-gen-rt.ar (num-outputs script &rest inputs) 68 | "See DynGen for a full introduction. 69 | 70 | DynGen defers the initialization of the EEL2 VM into a non-realtime thread. This introduces a delay of at least one block size. If therefore sample accurate sequencing becomes necessary, it is also possible to init the EEL2 VM within the realtime-audio thread, though this can lead to audio-dropouts and is therefore not advised. " 71 | (meta-dyn-gen "DynGenRT" num-outputs script 1.0 inputs)) 72 | 73 | 74 | 75 | -------------------------------------------------------------------------------- /ugens/Pan.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defugen (pan2 "Pan2") (in &optional (pos 0.0) (level 1.0)) 4 | ((:ar (multinew new 'multiout-ugen 2 in pos level)) 5 | (:kr (multinew new 'multiout-ugen 2 in pos level))) 6 | :check-fn (lambda (ugen) (check-n-inputs ugen 1))) 7 | 8 | (defugen (lin-pan2 "LinPan2") (in &optional (pos 0.0) (level 1.0)) 9 | ((:ar (multinew new 'multiout-ugen 2 in pos level)) 10 | (:kr (multinew new 'multiout-ugen 2 in pos level))) 11 | :check-fn (lambda (ugen) (check-n-inputs ugen 1))) 12 | 13 | (defugen (pan4 "Pan4") (in &optional (x-pos 0.0) (y-pos 0.0) (level 1.0)) 14 | ((:ar (multinew new 'multiout-ugen 4 in x-pos y-pos level)) 15 | (:kr (multinew new 'multiout-ugen 4 in x-pos y-pos level))) 16 | :check-fn (lambda (ugen) (check-n-inputs ugen 1))) 17 | 18 | (defugen (balance2 "Balance2") 19 | (left right &optional (pos 0.0) (level 1.0)) 20 | ((:ar (multinew new 'multiout-ugen 2 left right pos level)) 21 | (:kr (multinew new 'multiout-ugen 2 left right pos level))) 22 | :check-fn (lambda (ugen) (check-n-inputs ugen 2))) 23 | 24 | (defugen (rotate2 "Rotate2") (x y &optional (pos 0.0)) 25 | ((:ar (multinew new 'multiout-ugen 2 x y pos)) 26 | (:kr (multinew new 'multiout-ugen 2 x y pos))) 27 | :check-fn (lambda (ugen) (check-n-inputs ugen 2))) 28 | 29 | 30 | (defugen (pan-b "PanB") 31 | (in &optional (azimuth 0.0) (elevation 0.0) (gain 1.0)) 32 | ((:ar (multinew new 'multiout-ugen 4 in azimuth elevation gain)) 33 | (:kr (multinew new 'multiout-ugen 4 in azimuth elevation gain))) 34 | :check-fn (lambda (ugen) (check-n-inputs ugen 1))) 35 | 36 | 37 | (defugen (pan-b2 "PanB2") 38 | (in &optional (azimuth 0.0) (gain 1.0)) 39 | ((:ar (multinew new 'multiout-ugen 3 in azimuth gain)) 40 | (:kr (multinew new 'multiout-ugen 3 in azimuth gain))) 41 | :check-fn (lambda (ugen) (check-n-inputs ugen 1))) 42 | 43 | 44 | (defugen (bi-pan-b2 "BiPanB2") 45 | (in-a in-b &optional (azimuth 0.0) (gain 1.0)) 46 | ((:ar (multinew new 'multiout-ugen 3 in-a in-b azimuth gain)) 47 | (:kr (multinew new 'multiout-ugen 3 in-a in-b azimuth gain))) 48 | :check-fn (lambda (ugen) (check-n-inputs ugen 2))) 49 | 50 | (defugen (decode-b2 "DecodeB2") 51 | (num-chans w x y &optional (orientation 0.5)) 52 | ((:ar (multinew new 'multiout-ugen num-chans w x y orientation)) 53 | (:kr (multinew new 'multiout-ugen num-chans w x y orientation))) 54 | :check-fn (lambda (ugen) (check-n-inputs ugen 3))) 55 | 56 | (defugen (pan-az "PanAz") 57 | (num-chans in &optional (pos 0.0) (level 1.0) (width 2.0) (orientation 0.5)) 58 | ((:ar (multinew new 'multiout-ugen num-chans in pos level width orientation)) 59 | (:kr (multinew new 'multiout-ugen num-chans in pos level width orientation))) 60 | :check-fn (lambda (ugen) (check-n-inputs ugen 1))) 61 | 62 | 63 | (defugen (x-fade2 "XFade2") 64 | (in-a &optional (in-b 0.0) (pan 0.0) (level 1.0)) 65 | ((:ar (multinew new 'ugen in-a in-b pan level)) 66 | (:kr (multinew new 'ugen in-a in-b pan level))) 67 | :check-fn (lambda (ugen) (check-n-inputs ugen 2))) 68 | 69 | (defugen (lin-x-fade2 "LinXFade2") 70 | (in-a &optional (in-b 0.0) (pan 0.0) (level 1.0)) 71 | ((:ar (sc::mul (multinew new 'ugen in-a in-b pan) level)) 72 | (:kr (sc::mul (multinew new 'ugen in-a in-b pan) level))) 73 | :check-fn (lambda (ugen) (check-n-inputs ugen 2))) 74 | -------------------------------------------------------------------------------- /ugens/FFTUnpacking.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defclass pv-chain-ugen (width-first-ugen) ()) 4 | 5 | (defun unpack-1-fft (chain bufsize binindex &optional (whichmeasure 0)) 6 | (multinew (lambda (cls &rest inputs) (apply #'ugen-new "Unpack1FFT" :demand cls #'identity :bipolar 7 | inputs)) 8 | 'ugen chain bufsize binindex whichmeasure)) 9 | 10 | (defun unpack-fft (chain bufsize &optional (frombin 0) tobin) 11 | (labels ((range (start end) 12 | (loop for i from start to end collect i))) 13 | (let ((upperlimit (divide bufsize 2.0))) 14 | (setf tobin (if (not tobin) upperlimit (min tobin upperlimit))) 15 | (alexandria:flatten 16 | (flop 17 | (list (unpack-1-fft chain bufsize (range frombin tobin) 0) 18 | (unpack-1-fft chain bufsize (range frombin tobin) 1))))))) 19 | 20 | (defun pack-fft (chain bufsize magsphases &key (frombin 0) tobin (zeroothers 0)) 21 | (setf tobin (if tobin tobin (divide bufsize 2.0))) 22 | (apply 'multinew (lambda (cls &rest inputs) (apply #'ugen-new "PackFFT" :control cls #'identity :bipolar inputs)) 23 | 'pv-chain-ugen chain bufsize frombin tobin zeroothers (length magsphases) (alexandria:ensure-list magsphases))) 24 | 25 | (defmethod pv-calc ((pv-ugen pv-chain-ugen) frames func &key (frombin 0) tobin (zeroothers 0)) 26 | (let (origmagsphases magsphases) 27 | (setf origmagsphases (flop (clump (unpack-fft pv-ugen frames frombin tobin) 2))) 28 | (setf magsphases (funcall func (nth 0 origmagsphases) (nth 1 origmagsphases))) 29 | (setf magsphases (case (length magsphases) 30 | (1 (append magsphases (let ((orig (nth 1 origmagsphases))) 31 | (if (listp orig) orig (list orig))))) 32 | (2 magsphases) 33 | (t (list magsphases (nth 1 origmagsphases))))) 34 | (setf magsphases (alexandria:flatten (flop magsphases))) 35 | (pack-fft pv-ugen frames magsphases :frombin frombin :tobin tobin :zeroothers zeroothers))) 36 | 37 | (defmethod pv-calc2 ((pv-ugen pv-chain-ugen) chain2 frames func &key (frombin 0) tobin (zeroothers 0)) 38 | (let* ((origmagsphases (flop (clump (unpack-fft pv-ugen frames frombin tobin) 2))) 39 | (origmagsphases2 (flop (clump (unpack-fft chain2 frames frombin tobin) 2))) 40 | (magsphases (funcall func (nth 0 origmagsphases) 41 | (nth 1 origmagsphases) 42 | (nth 0 origmagsphases2) 43 | (nth 1 origmagsphases2)))) 44 | (setf magsphases (case (length magsphases) 45 | (1 (append magsphases (let ((orig (nth 1 origmagsphases))) 46 | (if (listp orig) orig (list orig))))) 47 | (2 magsphases) 48 | (t (list magsphases (nth 1 origmagsphases))))) 49 | (setf magsphases (alexandria:flatten (flop magsphases))) 50 | (pack-fft pv-ugen frames magsphases :frombin frombin :tobin tobin :zeroothers zeroothers))) 51 | 52 | 53 | 54 | 55 | 56 | (defmethod pv-collect ((pv-ugen pv-chain-ugen) frames func &key (frombin 0) tobin (zeroothers 0)) 57 | (let ((magsphases (clump (unpack-fft pv-ugen frames frombin tobin) 2)) 58 | (ret nil)) 59 | (setf magsphases 60 | (alexandria:flatten 61 | (loop repeat (length magsphases) 62 | for index from 0 63 | for mp = (nth index magsphases) 64 | collect 65 | (progn 66 | (setf ret (alexandria:ensure-list (funcall func (nth 0 mp) (nth 1 mp) (+ frombin index)))) 67 | (setf ret (if (= 1 (length ret)) (concatenate 'list ret (alexandria:ensure-list (nth 1 mp))) ret)))))) 68 | (pack-fft pv-ugen frames magsphases :frombin frombin :tobin tobin :zeroothers zeroothers))) 69 | -------------------------------------------------------------------------------- /osc/ecl-extension.lisp: -------------------------------------------------------------------------------- 1 | (in-package :sc-osc) 2 | 3 | (defun single-float-bits (x) 4 | (declare (type single-float x)) 5 | (assert (= (float-radix x) 2)) 6 | (cond ((zerop x) (if (eql x 0.0f0) 0 #x-80000000)) 7 | ((= ext:single-float-positive-infinity x) 2139095040) 8 | (t 9 | (multiple-value-bind (lisp-significand lisp-exponent lisp-sign) 10 | (integer-decode-float x) 11 | (assert (plusp lisp-significand)) 12 | ;; Calculate IEEE-style fields from Common-Lisp-style fields. 13 | 14 | ;; KLUDGE: This code was written from my foggy memory of what IEEE 15 | ;; format looks like, augmented by some experiments with 16 | ;; the existing implementation of SINGLE-FLOAT-BITS, and what 17 | ;; I found floating around on the net at 18 | ;; , 19 | ;; , 20 | ;; and 21 | ;; . 22 | ;; And beyond the probable sheer flakiness of the code, all the bare 23 | ;; numbers floating around here are sort of ugly, too. -- WHN 19990711 24 | (let* ((significand lisp-significand) 25 | (exponent (+ lisp-exponent 23 127)) 26 | (unsigned-result 27 | (if (plusp exponent) ; if not obviously denormalized 28 | (do () 29 | (nil) 30 | (cond (;; special termination case, denormalized 31 | ;; float number 32 | (zerop exponent) 33 | ;; Denormalized numbers have exponent one 34 | ;; greater than the exponent field. 35 | (return (ash significand -1))) 36 | (;; ordinary termination case 37 | (>= significand (expt 2 23)) 38 | (assert (< 0 significand (expt 2 24))) 39 | ;; Exponent 0 is reserved for 40 | ;; denormalized numbers, and 255 is 41 | ;; reserved for specials like NaN. 42 | (assert (< 0 exponent 255)) 43 | (return (logior (ash exponent 23) 44 | (logand significand 45 | (1- (ash 1 23)))))) 46 | 47 | (t 48 | ;; Shift as necessary to set bit 24 of 49 | ;; significand. 50 | (setf significand (ash significand 1) 51 | exponent (1- exponent))))) 52 | (do () 53 | ((zerop exponent) 54 | ;; Denormalized numbers have exponent one 55 | ;; greater than the exponent field. 56 | (ash significand -1)) 57 | (unless (zerop (logand significand 1)) 58 | (warn "denormalized SINGLE-FLOAT-BITS ~S losing bits" 59 | x)) 60 | (setf significand (ash significand -1) 61 | exponent (1+ exponent)))))) 62 | (ecase lisp-sign 63 | (1 unsigned-result) 64 | (-1 (logior unsigned-result (- (expt 2 31)))))))))) 65 | 66 | (defun make-single-float (bits) 67 | (cond 68 | ;; IEEE float special cases 69 | ((zerop bits) 0.0) 70 | ((= 2139095040 bits) ext:single-float-positive-infinity) 71 | ((= bits #x-80000000) -0.0) 72 | (t (let* ((sign (ecase (ldb (byte 1 31) bits) 73 | (0 1.0) 74 | (1 -1.0))) 75 | (iexpt (ldb (byte 8 23) bits)) 76 | (expt (if (zerop iexpt) ; denormalized 77 | -126 78 | (- iexpt 127))) 79 | (mant (* (logior (ldb (byte 23 0) bits) 80 | (if (zerop iexpt) 81 | 0 82 | (ash 1 23))) 83 | (expt 0.5 23)))) 84 | (* sign (expt 2.0 expt) mant))))) 85 | 86 | (defun osc::encode-float32 (f) 87 | (osc::encode-int32 (single-float-bits f))) 88 | 89 | (defun osc::decode-float32 (s) 90 | (make-single-float (osc::decode-int32 s))) 91 | 92 | -------------------------------------------------------------------------------- /ugens/InOut.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defugen (in "In") 4 | (&optional (bus 0) (chanls 1)) 5 | ((:ar (multinew new 'multiout-ugen chanls bus)) 6 | (:kr (multinew new 'multiout-ugen chanls bus)))) 7 | 8 | (defugen (local-in "LocalIn") (&optional (chanls 1) (default 0.0)) 9 | ((:ar (multinew new 'multiout-ugen chanls default)) 10 | (:kr (multinew new 'multiout-ugen chanls default)))) 11 | 12 | (defugen (lag-in "LagIn") (&optional (bus 0) (chanls 1) (lag 0.1)) 13 | ((:kr (multinew new 'multiout-ugen chanls bus lag)))) 14 | 15 | (defugen (in-feedback "InFeedback") (&optional (bus 0) (chanls 1)) 16 | ((:ar (multinew new 'multiout-ugen chanls bus)))) 17 | 18 | (defugen (in-trig "InTrig") (&optional (bus 0) (chanls 1)) 19 | ((:kr (multinew new 'multiout-ugen chanls bus)))) 20 | 21 | 22 | (defclass abstract-out (ugen) ()) 23 | 24 | (defmethod num-outputs ((ugen abstract-out)) 25 | 0) 26 | 27 | (defun abstract-out-check (ugen fixed-args) 28 | (when (eql (rate ugen) :audio) 29 | (loop for i from fixed-args below (length (inputs ugen)) 30 | do (unless (eql (rate (nth i (inputs ugen))) :audio) 31 | (error (format nil "Input at index ~a (~a) is not audio rate." 32 | i (nth i (inputs ugen)))))))) 33 | 34 | (defun replace-zeroes-with-silence (channel-array) 35 | (let* ((pos 0) 36 | (num-zeros (count 0 channel-array :test #'equalp))) 37 | (when (zerop num-zeros) (return-from replace-zeroes-with-silence channel-array)) 38 | (let ((silent-ch (alexandria:ensure-list (silent.ar num-zeros)))) 39 | (loop for item in channel-array 40 | for i from 0 41 | do (let (res) 42 | (if (equalp item 0.0) (progn (setf (nth i channel-array) (nth pos silent-ch)) 43 | (incf pos)) 44 | (when (listp item) 45 | (setf res (replace-zeroes-with-silence item)) 46 | (setf (nth i channel-array) res))))) 47 | channel-array))) 48 | 49 | 50 | (defugen (out "Out") (bus channels-array) 51 | ((:ar (let ((channels (replace-zeroes-with-silence (alexandria:ensure-list channels-array)))) 52 | (apply #'multinew new 'abstract-out (cons bus channels)) 53 | 0)) 54 | (:kr (progn 55 | (apply #'multinew new 'abstract-out (cons bus (alexandria:ensure-list channels-array))) 56 | 0))) 57 | :check-fn (lambda (ugen) (abstract-out-check ugen 1))) 58 | 59 | (defugen (replace-out "ReplaceOut") (bus channels-array) 60 | ((:ar (let ((channels (replace-zeroes-with-silence (alexandria:ensure-list channels-array)))) 61 | (apply #'multinew new 'abstract-out (cons bus channels)) 62 | 0)) 63 | (:kr (progn 64 | (apply #'multinew new 'abstract-out (cons bus (alexandria:ensure-list channels-array))) 65 | 0))) 66 | :check-fn (lambda (ugen) (abstract-out-check ugen 1))) 67 | 68 | (defugen (offset-out "OffsetOut") (bus channels-array) 69 | ((:ar (let ((channels (replace-zeroes-with-silence (alexandria:ensure-list channels-array)))) 70 | (apply #'multinew new 'abstract-out (cons bus channels)) 71 | 0)) 72 | (:kr (progn new (error "Control rate OffsetOut is not implemented (bus: ~a channels-array: ~a)." bus channels-array)))) 73 | :check-fn (lambda (ugen) (abstract-out-check ugen 1))) 74 | 75 | 76 | (defugen (local-out "LocalOut") (channels-array) 77 | ((:ar (let ((channels (replace-zeroes-with-silence (alexandria:ensure-list channels-array)))) 78 | (apply #'multinew new 'abstract-out channels) 79 | 0)) 80 | (:kr (progn (apply #'multinew new 'abstract-out (alexandria:ensure-list channels-array)) 81 | 0))) 82 | :check-fn (lambda (ugen) (abstract-out-check ugen 0))) 83 | 84 | 85 | (defugen (x-out "XOut") (bus xfade channels-array) 86 | ((:ar (let ((channels (replace-zeroes-with-silence (alexandria:ensure-list channels-array)))) 87 | (apply #'multinew new 'abstract-out (cons bus (cons xfade channels))) 88 | 0)) 89 | (:kr (progn (apply #'multinew new 'abstract-out (cons bus (cons xfade (alexandria:ensure-list channels-array)))) 0))) 90 | :check-fn (lambda (ugen) (abstract-out-check ugen 2))) 91 | 92 | 93 | -------------------------------------------------------------------------------- /ugens/Chaos.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defugen (quad-n "QuadN") 4 | (&optional (freq 22050) (a 1) (b -1) (c -0.75) (xi 0) &key (mul 1) (add 0)) 5 | ((:ar (madd (multinew new 'ugen freq a b c xi) mul add)))) 6 | 7 | (defugen (quad-l "QuadL") 8 | (&optional (freq 22050) (a 1) (b -1) (c -0.75) (xi 0) &key (mul 1) (add 0)) 9 | ((:ar (madd (multinew new 'ugen freq a b c xi) mul add)))) 10 | 11 | (defugen (quad-c "QuadC") 12 | (&optional (freq 22050) (a 1) (b -1) (c -0.75) (xi 0) &key (mul 1) (add 0)) 13 | ((:ar (madd (multinew new 'ugen freq a b c xi) mul add)))) 14 | 15 | (defugen (cusp-n "CuspN") 16 | (&optional (freq 22050) (a 1) (b 1.9) (xi 0) &key (mul 1) (add 0)) 17 | ((:ar (madd (multinew new 'ugen freq a b xi) mul add)))) 18 | 19 | (defugen (cusp-l "CuspL") 20 | (&optional (freq 22050) (a 1) (b 1.9) (xi 0) &key (mul 1) (add 0)) 21 | ((:ar (madd (multinew new 'ugen freq a b xi) mul add)))) 22 | 23 | 24 | (defugen (gbman-n "GbmanN") 25 | (&optional (freq 22050) (xi 1.2) (yi 2.1) &key (mul 1) (add 0)) 26 | ((:ar (madd (multinew new 'ugen freq xi yi) mul add)))) 27 | 28 | (defugen (gbman-l "GbmanL") 29 | (&optional (freq 22050) (xi 1.2) (yi 2.1) &key (mul 1) (add 0)) 30 | ((:ar (madd (multinew new 'ugen freq xi yi) mul add)))) 31 | 32 | (defugen (henon-n "HenonN") 33 | (&optional (freq 22050) (a 1.4) (b 0.3) (x0 0) (x1 0) &key (mul 1) (add 0)) 34 | ((:ar (madd (multinew new 'ugen freq a b x0 x1) mul add)))) 35 | 36 | (defugen (henon-l "HenonL") 37 | (&optional (freq 22050) (a 1.4) (b 0.3) (x0 0) (x1 0) &key (mul 1) (add 0)) 38 | ((:ar (madd (multinew new 'ugen freq a b x0 x1) mul add)))) 39 | 40 | (defugen (henon-c "HenonC") 41 | (&optional (freq 22050) (a 1.4) (b 0.3) (x0 0) (x1 0) &key (mul 1) (add 0)) 42 | ((:ar (madd (multinew new 'ugen freq a b x0 x1) mul add)))) 43 | 44 | (defugen (latoocarfian-n "LatoocarfianN") 45 | (&optional (freq 22050) (a 1) (b 3) (c 0.5) (d 0.5) (xi 0.5) (yi 0.5) 46 | &key (mul 1.0) (add 0.0)) 47 | ((:ar (madd (multinew new 'ugen freq a b c d xi yi) mul add)))) 48 | 49 | (defugen (latoocarfian-l "LatoocarfianL") 50 | (&optional (freq 22050) (a 1) (b 3) (c 0.5) (d 0.5) (xi 0.5) (yi 0.5) 51 | &key (mul 1.0) (add 0.0)) 52 | ((:ar (madd (multinew new 'ugen freq a b c d xi yi) mul add)))) 53 | 54 | (defugen (latoocarfian-c "LatoocarfianC") 55 | (&optional (freq 22050) (a 1) (b 3) (c 0.5) (d 0.5) (xi 0.5) (yi 0.5) 56 | &key (mul 1.0) (add 0.0)) 57 | ((:ar (madd (multinew new 'ugen freq a b c d xi yi) mul add)))) 58 | 59 | (defugen (lincong-n "LinCongN") 60 | (&optional (freq 22050) (a 1.0) (c 0.13) (m 1.0) (xi 0) &key (mul 1.0) (add 0)) 61 | ((:ar (madd (multinew new 'ugen freq a c m xi) mul add)))) 62 | 63 | (defugen (lincong-l "LinCongL") 64 | (&optional (freq 22050) (a 1.0) (c 0.13) (m 1.0) (xi 0) &key (mul 1.0) (add 0)) 65 | ((:ar (madd (multinew new 'ugen freq a c m xi) mul add)))) 66 | 67 | (defugen (lincong-c "LinCongC") 68 | (&optional (freq 22050) (a 1.0) (c 0.13) (m 1.0) (xi 0) &key (mul 1.0) (add 0)) 69 | ((:ar (madd (multinew new 'ugen freq a c m xi) mul add)))) 70 | 71 | (defugen (standard-n "StandardN") 72 | (&optional (freq 22050) (k 1.0) (xi 0.5) (yi 0) &key (mul 1.0) (add 0.0)) 73 | ((:ar (madd (multinew new 'ugen freq k xi yi) mul add)))) 74 | 75 | (defugen (standard-l "StandardL") 76 | (&optional (freq 22050) (k 1.0) (xi 0.5) (yi 0) &key (mul 1.0) (add 0.0)) 77 | ((:ar (madd (multinew new 'ugen freq k xi yi) mul add)))) 78 | 79 | (defugen (fbsine-n "FBSineN") 80 | (&optional (freq 22050) (im 1) (fb 0.1) (a 1.1) (c 0.5) (xi 0.1) (yi 0.1) 81 | &key (mul 1.0) (add 0.0)) 82 | ((:ar (madd (multinew new 'ugen freq im fb a c xi yi) mul add)))) 83 | 84 | (defugen (fbsine-l "FBSineL") 85 | (&optional (freq 22050) (im 1) (fb 0.1) (a 1.1) (c 0.5) (xi 0.1) (yi 0.1) 86 | &key (mul 1.0) (add 0.0)) 87 | ((:ar (madd (multinew new 'ugen freq im fb a c xi yi) mul add)))) 88 | 89 | (defugen (fbsine-c "FBSineC") 90 | (&optional (freq 22050) (im 1) (fb 0.1) (a 1.1) (c 0.5) (xi 0.1) (yi 0.1) 91 | &key (mul 1.0) (add 0.0)) 92 | ((:ar (madd (multinew new 'ugen freq im fb a c xi yi) mul add)))) 93 | 94 | (defugen (lorenz-l "LorenzL") 95 | (&optional (freq 22050) (s 10) (r 28) (b 2.667) (h 0.05) (xi 0.1) (yi 0) 96 | (zi 0) &key (mul 1.0) (add 0.0)) 97 | ((:ar (madd (multinew new 'ugen freq s r b h xi yi zi) mul add)))) 98 | -------------------------------------------------------------------------------- /package.lisp: -------------------------------------------------------------------------------- 1 | (eval-when (:compile-toplevel :load-toplevel :execute) 2 | (named-readtables:defreadtable :sc 3 | (:merge 4 | #-ccl :common-lisp 5 | #+ccl :current))) 6 | 7 | 8 | (defpackage #:cl-collider 9 | (:use #:cl) 10 | (:nicknames #:sc) 11 | #+ccl (:import-from :ccl #:make-id-map #:assign-id-map-id #:id-map-free-object) 12 | #+sbcl (:lock t) 13 | (:export #:*s* 14 | #:*sc-synth-program* 15 | #:*sc-plugin-paths* 16 | #:*sc-synthdefs-path* 17 | #:+inf+ 18 | 19 | #+(or linux freebsd) #:jack-connect 20 | 21 | #:sched-ahead 22 | #:latency 23 | 24 | #:make-server-options 25 | #:server-options 26 | #:server-options-num-input-bus 27 | #:server-options-num-output-bus 28 | #:server-options-device 29 | #:server-options-block-size 30 | 31 | #:*synth-definition-mode* 32 | #:defsynth 33 | #:synth 34 | #:get-synthdef-metadata 35 | #:synthdef-metadata 36 | #:with-controls 37 | #:named-control 38 | #:kr 39 | #:play 40 | #:proxy 41 | #:proxy-ctrl 42 | 43 | #:with-rendering 44 | 45 | #:all-running-servers 46 | #:make-external-server 47 | #:server-boot 48 | #:server-quit 49 | #:boot-p 50 | #:send-message 51 | #:send-bundle 52 | 53 | #:control-get 54 | #:control-set 55 | #:add-reply-responder 56 | #:remove-reply-responder 57 | #:with-async 58 | #:sync 59 | 60 | #:at 61 | #:free 62 | #:release 63 | #:ctrl 64 | #:map-bus 65 | #:is-playing-p 66 | 67 | #:move-node 68 | 69 | #:make-group 70 | #:server-query-all-nodes 71 | #:group-free-all 72 | #:server-free-all 73 | #:stop 74 | #:server-status 75 | #:*server-boot-hooks* 76 | #:*server-quit-hooks* 77 | #:*server-free-all-hooks* 78 | #:*stop-hooks* 79 | 80 | #:now 81 | #:callback 82 | #:quant 83 | #:set-clock 84 | #:clock-bpm 85 | #:clock-beats 86 | #:clock-add 87 | #:clock-quant 88 | #:clock-dur 89 | #:clock-clear 90 | #:at-beat 91 | #:at-task 92 | 93 | #:bufnum 94 | #:sr 95 | #:frames 96 | #:chanls 97 | #:path 98 | #:buffer-read 99 | #:buffer-read-channel 100 | #:buffer-alloc 101 | #:buffer-set-sr 102 | #:buffer-alloc-sequence 103 | #:buffer-cue-soundfile 104 | #:buffer-close 105 | #:buffer-free 106 | #:buffer-write 107 | #:buffer-get 108 | #:buffer-getn 109 | #:buffer-get-to-list 110 | #:buffer-load-to-list 111 | #:buffer-to-list 112 | #:buffer-get-to-array 113 | #:buffer-load-to-array 114 | #:buffer-to-array 115 | #:buffer-set 116 | #:buffer-setn 117 | #:buffer-load 118 | #:buffer-send-sequence 119 | #:buffer-load-sequence 120 | #:buffer-zero 121 | #:buffer-normalize 122 | #:buffer-dur 123 | #:buffer-copy 124 | 125 | #:buffer-fill 126 | #:buffer-read-as-wavetable 127 | #:calc-pv-recsize 128 | #:local-buf 129 | #:set-buf 130 | #:clear-buf 131 | #:local-buf-list 132 | #:as-wavetable 133 | #:as-wavetable-no-wrap 134 | 135 | #:bus-audio 136 | #:bus-control 137 | #:bus-free 138 | #:bus-string 139 | #:busnum 140 | 141 | #:neg 142 | #:reciprocal 143 | #:frac 144 | #:sign 145 | #:squared 146 | #:cubed 147 | #:midicps 148 | #:cpsmidi 149 | #:midiratio 150 | #:dbamp 151 | #:ampdb 152 | #:distort 153 | #:softclip 154 | #:trunc 155 | #:fold2 156 | #:madd 157 | #:mix 158 | #:sum 159 | #:bubble 160 | #:unbubble 161 | #:flop 162 | #:clump 163 | #:mean 164 | #:product 165 | #:dup 166 | #:== 167 | #:if~ 168 | #:clip 169 | #:clip2 170 | #:fold 171 | #:wrap 172 | #:range 173 | #:exp-range 174 | #:unipolar 175 | #:bipolar 176 | #:lin-lin 177 | #:lin-exp 178 | #:exp-lin 179 | #:exp-exp 180 | 181 | #:env-shape-number 182 | #:env 183 | #:triangle 184 | #:sine 185 | #:perc 186 | #:linen 187 | #:cutoff 188 | #:dadsr 189 | #:adsr 190 | #:asr 191 | #:env-at 192 | #:env-as-signal 193 | 194 | #:fft 195 | #:pv-calc 196 | #:pv-calc2 197 | #:pv-collect 198 | #:running-sum-rms 199 | 200 | #:part-conv-calc-buf-size 201 | #:buffer-prepare-part-conv)) 202 | 203 | (defpackage #:sc-user 204 | (:use #:cl #:sc)) 205 | 206 | (in-package :sc-user) 207 | (named-readtables:in-readtable :sc) 208 | -------------------------------------------------------------------------------- /ugens/Demand.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defugen (demand "Demand") (trig reset demand-ugens) 4 | ((:ar (let ((demand-ugens (alexandria:ensure-list demand-ugens))) 5 | (apply #'multinew new 'multiout-ugen (length demand-ugens) trig reset demand-ugens))) 6 | (:kr (let ((demand-ugens (alexandria:ensure-list demand-ugens))) 7 | (apply #'multinew new 'multiout-ugen (length demand-ugens) trig reset demand-ugens)))) 8 | :check-fn #'check-same-rate-as-first-input) 9 | 10 | 11 | (defun check-duty (ugen) 12 | (when (eql (rate (nth 0 (inputs ugen))) :demand) 13 | (unless (find (rate (nth 1 (inputs ugen))) (list :demand :scalar (rate ugen))) 14 | (error (format nil "Reset input cannot be ~a rate (input: ~a rate: ~a)." 15 | (rate ugen) (nth 1 (inputs ugen)) (rate (nth 1 (inputs ugen)))))))) 16 | 17 | (defugen (duty "Duty") (&optional (dur 1.0) &key (reset 0.0) (level 1.0) (act :no-action)) 18 | ((:ar (multinew new 'ugen dur reset (act act) level)) 19 | (:kr (multinew new 'ugen dur reset (act act) level))) 20 | :check-fn #'check-duty) 21 | 22 | (defugen (t-duty "TDuty") (&optional (dur 1.0) &key (reset 0.0) (level 1.0) (act :no-action) (gap-first 0)) 23 | ((:ar (multinew new 'ugen dur reset (act act) level gap-first)) 24 | (:kr (multinew new 'ugen dur reset (act act) level gap-first))) 25 | :check-fn #'check-duty) 26 | 27 | 28 | (defugen (demand-envgen "DemandEnvGen") 29 | (level dur &key (shape 1) (curve 0) (gate 1.0) (reset 1.0) 30 | (level-scale 1.0) (level-bias 0.0) (time-scale 1.0) (act :no-action)) 31 | ((:kr (multinew new 'ugen level dur shape curve gate reset level-scale level-bias time-scale (act act))) 32 | (:ar (progn 33 | (when (or (eql (rate gate) :audio) 34 | (eql (rate reset) :audio)) 35 | (when (not (eql (rate gate) :audio)) 36 | (setf gate (k2a.ar gate))) 37 | (when (not (eql (rate reset) :audio)) 38 | (setf reset (k2a.ar reset)))) 39 | (multinew new 'ugen level dur shape curve gate reset level-scale level-bias time-scale (act act)))))) 40 | 41 | 42 | (defclass dugen (ugen) 43 | ()) 44 | ;;; todo 45 | 46 | 47 | 48 | (defmacro def-dugen (name args &body body) 49 | `(progn (defun ,(car name) ,args 50 | (let ((new (lambda (cls &rest inputs) (apply #'ugen-new ,(second name) :demand cls 51 | #'identity :bipolar inputs)))) 52 | ,@body)) 53 | (export ',(car name)))) 54 | 55 | (def-dugen (d-series "Dseries") (&optional (start 1) (step 1) (length +inf+)) 56 | (multinew new 'dugen length start step)) 57 | 58 | (def-dugen (d-geom "Dgeom") (&optional (start 1) (grow 2) (length +inf+)) 59 | (multinew new 'dugen length start grow)) 60 | 61 | (def-dugen (d-bufrd "Dbufrd") (&optional (bufnum 0) (phase 0) (loop 1.0)) 62 | (multinew new 'dugen bufnum phase loop)) 63 | 64 | (def-dugen (d-bufwr "Dbufwr") (&optional (input 0.0) (bufnum 0) (phase 0.0) (loop 1.0)) 65 | (multinew new 'dugen bufnum phase input loop)) 66 | 67 | (def-dugen (list-dugen "ListDUGen") (list &optional (repeats 1)) 68 | (apply 'multinew new 'dugen repeats list)) 69 | 70 | (def-dugen (d-seq "Dseq") (list &optional (repeats 1)) 71 | (apply 'multinew new 'dugen repeats list)) 72 | 73 | (def-dugen (d-ser "Dser") (list &optional (repeats 1)) 74 | (apply 'multinew new 'dugen repeats list)) 75 | 76 | (def-dugen (d-shuf "Dshuf") (list &optional (repeats 1)) 77 | (apply 'multinew new 'dugen repeats list)) 78 | 79 | (def-dugen (d-rand "Drand") (list &optional (repeats 1)) 80 | (apply 'multinew new 'dugen repeats list)) 81 | 82 | (def-dugen (d-xrand "Dxrand") (list &optional (repeats 1)) 83 | (apply 'multinew new 'dugen repeats list)) 84 | 85 | (def-dugen (d-switch1 "Dswitch1") (list index) 86 | (apply 'multinew new 'dugen index list)) 87 | 88 | (def-dugen (d-switch "Dswitch") (list index) 89 | (apply 'multinew new 'dugen index list)) 90 | 91 | (def-dugen (d-white "Dwhite") (&optional (lo 0.0) (hi 1.0) (length +inf+)) 92 | (multinew new 'dugen length lo hi)) 93 | 94 | (def-dugen (d-iwhite "Diwhite") (&optional (lo 0.0) (hi 1.0) (length +inf+)) 95 | (multinew new 'dugen length lo hi)) 96 | 97 | (def-dugen (d-brown "Dbrown") (&optional (lo 0.0) (hi 1.0) (step 0.01) (length +inf+)) 98 | (multinew new 'dugen length lo hi step)) 99 | 100 | (def-dugen (d-ibrown "Dibrown") (&optional (lo 0.0) (hi 1.0) (step 0.01) (length +inf+)) 101 | (multinew new 'dugen length lo hi step)) 102 | 103 | (def-dugen (d-stutter "Dstutter") (n in) 104 | (multinew new 'dugen n in)) 105 | 106 | (def-dugen (d-once "Donce") (in) 107 | (multinew new 'dugen in)) 108 | 109 | (def-dugen (d-reset "Dreset") (in &optional (reset 0.0)) 110 | (multinew new 'dugen in reset)) 111 | 112 | (def-dugen (d-poll "Dpoll") (in label &optional (run 1) (trigid -1)) 113 | (multinew new 'dugen in label run trigid)) 114 | 115 | -------------------------------------------------------------------------------- /ugens/SC3plugins/JoshUGens.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (def-pv-chain-ugen (pv-noise-synth-p "PV_NoiseSynthP") 4 | (buffer &optional (threshold 0.1) (num-frames 2.0) (initflag 0.0)) 5 | (multinew new 'pv-chain-ugen buffer threshold num-frames initflag)) 6 | 7 | (def-pv-chain-ugen (pv-partial-synth-p "PV_PartialSynthP") 8 | (buffer &optional (threshold 0.1) (num-frames 2.0) (initflag 0.0)) 9 | (multinew new 'pv-chain-ugen buffer threshold num-frames initflag)) 10 | 11 | (def-pv-chain-ugen (pv-noise-synth-f "PV_NoiseSynthF") 12 | (buffer &optional (threshold 0.1) (num-frames 2.0) (initflag 0.0)) 13 | (multinew new 'pv-chain-ugen buffer threshold num-frames initflag)) 14 | 15 | (def-pv-chain-ugen (pv-partial-synth-f "PV_PartialSynthF") 16 | (buffer &optional (threshold 0.1) (num-frames 2.0) (initflag 0.0)) 17 | (multinew new 'pv-chain-ugen buffer threshold num-frames initflag)) 18 | 19 | (def-pv-chain-ugen (pv-mag-map "PV_MagMap") 20 | (buffer mapbuf) 21 | (multinew new 'pv-chain-ugen buffer mapbuf)) 22 | 23 | (def-pv-chain-ugen (pv-max-mag-n "PV_MaxMagN") 24 | (buffer numbins) 25 | (multinew new 'pv-chain-ugen buffer numbins)) 26 | 27 | (def-pv-chain-ugen (pv-min-mag-n "PV_MinMagN") 28 | (buffer numbins) 29 | (multinew new 'pv-chain-ugen buffer numbins)) 30 | 31 | (def-pv-chain-ugen (pv-mag-buffer "PV_MagBuffer") 32 | (buffer databuffer) 33 | (multinew new 'pv-chain-ugen buffer databuffer)) 34 | 35 | (def-pv-chain-ugen (pv-freq-buffer "PV_FreqBuffer") 36 | (buffer databuffer) 37 | (multinew new 'pv-chain-ugen buffer databuffer)) 38 | 39 | (def-pv-chain-ugen (pv-odd-bin "PV_OddBin") 40 | (buffer) 41 | (multinew new 'pv-chain-ugen buffer)) 42 | 43 | (def-pv-chain-ugen (pv-even-bin "PV_EvenBin") 44 | (buffer) 45 | (multinew new 'pv-chain-ugen buffer)) 46 | 47 | (def-pv-chain-ugen (pv-bin-filter "PV_BinFilter") 48 | (buffer &optional (start 0) (end 0)) 49 | (multinew new 'pv-chain-ugen buffer start end)) 50 | 51 | (def-pv-chain-ugen (pv-invert "PV_Invert") 52 | (buffer) 53 | (multinew new 'pv-chain-ugen buffer)) 54 | 55 | (def-pv-chain-ugen (pv-bin-delay "PV_BinDelay") 56 | (buffer maxdelay delaybuf fbbuf &optional (hop 0.5)) 57 | (multinew new 'pv-chain-ugen buffer maxdelay delaybuf fbbuf hop)) 58 | 59 | (def-pv-chain-ugen (pv-freeze "PV_Freeze") 60 | (buffer &optional (freeze 0.0)) 61 | (multinew new 'pv-chain-ugen buffer freeze)) 62 | 63 | 64 | (defgeneric calc-pv-recsize (buffer frame-size hop &optional sample-rate)) 65 | 66 | (defmethod calc-pv-recsize ((buffer buffer) frame-size hop &optional sample-rate) 67 | (calc-pv-recsize (* 1.0 (/ (frames buffer) (sr buffer))) frame-size hop sample-rate)) 68 | 69 | (defmethod calc-pv-recsize ((buffer number) frame-size hop &optional sample-rate) 70 | (let ((rawsize)) 71 | (setf sample-rate (if sample-rate sample-rate 44100.0)) 72 | (setf rawsize (* frame-size (ceil~ (/ (* buffer sample-rate) frame-size)))) 73 | (+ (* rawsize (reciprocal hop)) 3))) 74 | 75 | 76 | (def-pv-chain-ugen (pv-record-buf "PV_RecordBuf") 77 | (buffer recbuf &key (offset 0.0) (run 0.0) (loop 0.0) 78 | (hop 0.5) (wintype 0)) 79 | (multinew new 'pv-chain-ugen buffer recbuf offset run loop hop wintype)) 80 | 81 | (def-pv-chain-ugen (pv-play-buf "PV_PlayBuf") 82 | (buffer playbuf rate &key (offset 0.0) (loop 0.0)) 83 | (multinew new 'pv-chain-ugen buffer playbuf rate offset loop)) 84 | 85 | (def-pv-chain-ugen (pv-bin-play-buf "PV_BinPlayBuf") 86 | (buffer playbuf rate &key (offset 0.0) (binstart 0.0) (binskip 1.0) (numbins 1.0) (loop 0.0) (clear 0.0)) 87 | (multinew new 'pv-chain-ugen buffer playbuf rate offset loop binstart binskip numbins clear)) 88 | 89 | (def-pv-chain-ugen (pv-buf-rd "PV_BufRd") 90 | (buffer playbuf &key (point 1.0)) 91 | (multinew new 'pv-chain-ugen buffer playbuf point)) 92 | 93 | (def-pv-chain-ugen (pv-bin-buf-rd "PV_BinBufRd") 94 | (buffer playbuf &key (point 1.0) (binstart 0.0) (binskip 1.0) (numbins 1.0) (clear 0.0)) 95 | (multinew new 'pv-chain-ugen buffer playbuf point binstart binskip numbins clear)) 96 | 97 | (def-pv-chain-ugen (pv-spectral-map "PV_SpectralMap") 98 | (buffer specbuffer &key (floor 0.0) (freeze 0.0) (mode 0.0) (norm 0.0) (window 0.0)) 99 | (multinew new 'pv-chain-ugen buffer specbuffer floor freeze mode norm window)) 100 | 101 | (def-pv-chain-ugen (pv-spectral-enhance "PV_SpectralEnhance") 102 | (buffer &key (num-partials 8) (ratio 2.0) (strength 0.1)) 103 | (multinew new 'pv-chain-ugen buffer num-partials ratio strength)) 104 | 105 | (defugen (bin-data "BinData") 106 | (buffer bin &optional (overlaps 0.5)) 107 | ((:ar (multinew new 'multiout-ugen 2 buffer bin overlaps)) 108 | (:kr (multinew new 'multiout-ugen 2 buffer bin overlaps)))) 109 | 110 | 111 | ;; very poorly implemented for the time being - do not use 112 | ;; PV_PitchShift 113 | 114 | 115 | 116 | -------------------------------------------------------------------------------- /ugens/Extensions/mi-UGens.lisp: -------------------------------------------------------------------------------- 1 | ;; 2 | ;; https://github.com/v7b1/mi-UGens 3 | ;; 4 | 5 | (in-package :sc) 6 | 7 | 8 | (defugen (mi-rings "MiRings") 9 | (&optional (in .0) (trig .0) (pitch 60.0) (struct .25) (bright .5) 10 | &key (damp .7) (pos .25) (model .0) (poly 1.0) (intern-exciter .0) (easteregg .0) (bypass .0) (mul 1.0) (add .0)) 11 | ((:ar (madd (multinew new 'multiout-ugen 2 in trig pitch struct bright damp pos model poly 12 | intern-exciter easteregg bypass) mul add)))) 13 | 14 | 15 | 16 | (defugen (mi-plaits "MiPlaits") 17 | (&optional (pitch 60) (engine 0) (harm .1) (timbre .5) (morph .5) (trig .0) &key (level .0) (fm-mod .0) (timb-mod .0) (morph-mod .0) (decay .5) (lpg-colour .5) (mul 1.0)) 18 | ((:ar (madd (multinew new 'multiout-ugen 2 pitch engine harm timbre morph trig level fm-mod timb-mod morph-mod decay lpg-colour) mul)))) 19 | 20 | 21 | 22 | (defugen (mi-clouds "MiClouds") 23 | (input-array &optional (pitch .0) (pos .5) (size .25) (dens .4) (tex .5) 24 | &key (drywet .5) (in-gain 1.0) (spread .5) (rvb .0) (fb .0) (freeze .0) (mode .0) (lofi .0) (trig .0) (mul 1.0) (add .0)) 25 | ((:ar (madd (apply #'multinew new 'multiout-ugen 2 pitch pos size dens tex drywet in-gain spread rvb fb freeze mode lofi trig (alexandria:ensure-list input-array)) mul add))) 26 | :check-fn (lambda (ugen) 27 | (assert (eql :audio (rate (nth 14 (inputs ugen)))) nil "input-array is note audio rate: ~a ~a" (nth 14 (inputs ugen)) (rate (nth 14 (inputs ugen))) ))) 28 | 29 | 30 | 31 | (defugen (mi-braids "MiBraids") 32 | (&optional (pitch 60) (timbre .5) (color .5) (model .0) (trig .0) &key (resamp .0) 33 | (decim .0) (bits .0) (ws .0) (mul 1.0)) 34 | ((:ar 35 | (madd (multinew new 'ugen pitch timbre color model trig resamp decim bits ws) mul)))) 36 | 37 | 38 | 39 | (defugen (mi-elements "MiElements") 40 | (&optional (blow-in 0) (strike-in 0) (gate 0) (pitch 48) (strength .5) (contour .2) 41 | &key (bow-level 0) (blow-level 0) (strike-level 0) (flow .5) (mallet .5) 42 | (bow-timb .5) (blow-timb .5) (strike-timb .5) (geom .25) (bright .5) (damp .7) 43 | (pos .2) (space .3) (model 0) (easteregg 0) (mul 1.0) (add .0)) 44 | ((:ar (madd (multinew new 'multiout-ugen 2 blow-in strike-in gate pitch strength contour 45 | bow-level blow-level strike-level flow mallet bow-timb blow-timb strike-timb geom bright damp pos space model easteregg) mul add)))) 46 | 47 | 48 | 49 | (defugen (mi-grids "MiGrids") 50 | (&key (on-off 1) (bpm 120) (map-x .5) (map-y .5) (chaos .0) (bd-dens .25) (sd-dens .25) (hh-dens .25) (clock-trig .0) (reset-trig .0) (ext-clock .0) (mode .0) (swing .0) (config .0) (reso 2)) 51 | ((:ar (multinew new 'multiout-ugen 8 on-off bpm map-x map-y chaos bd-dens sd-dens hh-dens clock-trig reset-trig ext-clock mode swing config reso)))) 52 | 53 | 54 | 55 | (defugen (mi-mu "MiMu") 56 | (in &optional (gain 1.0) (bypass .0) (mul 1.0) (add .0)) 57 | ((:ar (madd (multinew new 'ugen in gain bypass) mul add))) 58 | :check-fn #'check-same-rate-as-first-input) 59 | 60 | 61 | 62 | (defugen (mi-omi "MiOmi") 63 | (audio-in &optional (gate .0) (pit 48) &key (contour .2) (detune .25) (level1 .5) (level2 .5) (ratio1 .5) (ratio2 .5) (fm1 .0) (fm2 .0) (fb .0) (xfb .0) (filter-mode .0) (cutoff .5) (reson .0) (strength .5) (env .5) (rotate .2) (space .5) (mul 1.0) (add .0)) 64 | ((:ar (madd (multinew new 'multiout-ugen 2 audio-in gate pit contour detune level1 level2 ratio1 ratio2 fm1 fm2 fb xfb filter-mode cutoff reson strength env rotate space) mul add)))) 65 | 66 | 67 | 68 | (defugen (mi-ripples "MiRipples") 69 | (in &optional (cf .3) (reson .2) (drive 1.) (mul 1.0) (add .0)) 70 | ((:ar (madd (multinew new 'ugen in cf reson drive) mul add))) 71 | :check-fn #'check-same-rate-as-first-input) 72 | 73 | 74 | 75 | (defugen (mi-tides "MiTides") 76 | (&key (freq 1) (shape .5) (slope .5) (smooth .5) (shift .2) (trig .0) (clock .0) (output-mode 3) (ramp-mode 1) (ratio 9) (rate 1) (mul 1.0) (add .0)) 77 | ((:ar (madd (multinew new 'multiout-ugen 4 freq shape slope smooth shift trig clock output-mode ramp-mode ratio rate) mul add)))) 78 | 79 | 80 | 81 | (defugen (mi-verb "MiVerb") 82 | (input-array &key (time .7) (drywet .5) (damp .5) (hp .05) (freeze .0) (diff .625) (mul 1.0) (add .0)) 83 | ((:ar (madd (apply #'multinew new 'multiout-ugen 2 time drywet damp hp freeze diff (alexandria:ensure-list input-array)) mul add))) 84 | :check-fn (lambda (ugen) 85 | (let* ((inputs (inputs ugen))) 86 | (dotimes (i (- (length inputs) 6)) 87 | (unless (eql :audio (rate (nth (+ i 6) inputs))) 88 | (error "input is not audio rate: ~a ~a" (nth (+ i 6) inputs) (rate (nth (+ i 6) inputs)))))))) 89 | 90 | 91 | 92 | (defugen (mi-warps "MiWarps") 93 | (&optional (carrier .0) (modulator .0) &key (lev1 .5) (lev2 .5) (algo .0) (timb .0) (osc .0) (freq 110.0) (vgain 1.0) (easteregg .0)) 94 | ((:ar (multinew new 'multiout-ugen 2 carrier modulator lev1 lev2 algo timb osc freq vgain easteregg)))) 95 | -------------------------------------------------------------------------------- /ugens/BufIO.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defugen (play-buf "PlayBuf") 4 | (chanls &optional (bufnum 0) (rate 1.0) &key (trig 1.0) (start-pos 0.0) (loop 0.0) (act :no-action)) 5 | ((:ar (multinew new 'multiout-ugen chanls bufnum rate trig start-pos loop (act act))) 6 | (:kr (multinew new 'multiout-ugen chanls bufnum rate trig start-pos loop (act act))))) 7 | 8 | 9 | 10 | (defugen (tgrains "TGrains") 11 | (chanls &optional (trigger 0) (bufnum 0) (rate 1) (center-pos 0) 12 | (dur 0.1) (pan 0.0) (amp 0.1) (interp 4)) 13 | ((:ar (progn (when (< chanls 2) (error "TGrains needs at least two channels.")) 14 | (multinew new 'multiout-ugen chanls trigger bufnum rate center-pos dur pan amp interp))))) 15 | 16 | 17 | (defugen (buf-rd "BufRd") 18 | (chanls &optional (bufnum 0) (phase 0.0) (loop 1) (interp 2)) 19 | ((:ar (multinew new 'multiout-ugen chanls bufnum phase loop interp)) 20 | (:kr (multinew new 'multiout-ugen chanls bufnum phase loop interp))) 21 | :check-fn #'check-when-audio) 22 | 23 | 24 | (defugen (buf-wr "BufWr") 25 | (input-array &optional (bufnum 0) (phase 0.0) (loop 1.0)) 26 | ((:ar (multinew-list new 'ugen (append (list bufnum phase loop) (alexandria:ensure-list input-array)))) 27 | (:kr (multinew-list new 'ugen (append (list bufnum phase loop) (alexandria:ensure-list input-array))))) 28 | :check-fn #'check-when-audio) 29 | 30 | 31 | (defugen (record-buf "RecordBuf") 32 | (input-array &optional (bufnum 0) &key (offset 0.0) (rec-level 1.0) (pre-level 0.0) 33 | (run 1.0) (loop 1.0) (trig 1.0) (act :no-action)) 34 | ((:ar (multinew-list new 'ugen (append (list bufnum offset rec-level pre-level run loop trig (act act)) 35 | (alexandria:ensure-list input-array)))) 36 | (:kr (multinew-list new 'ugen (append (list bufnum offset rec-level pre-level run loop trig (act act)) 37 | (alexandria:ensure-list input-array)))))) 38 | 39 | (defugen (scope-out "ScopeOut") (input-array &optional (bufnum 0)) 40 | ((:ar (progn (multinew-list new 'ugen (cons bufnum (alexandria:ensure-list input-array))) 0)) 41 | (:kr (progn (multinew-list new 'ugen (cons bufnum (alexandria:ensure-list input-array))) 0)))) 42 | 43 | (defugen (scope-out2 "ScopeOut2") (input-array &optional (scope-num 0) (max-frames 4096) scope-frames) 44 | ((:ar (progn (multinew-list new 'ugen (append (list scope-num max-frames (if scope-frames scope-frames max-frames)) 45 | (alexandria:ensure-list input-array))) 0)) 46 | (:kr (progn (multinew-list new 'ugen (append (list scope-num max-frames (if scope-frames scope-frames max-frames)) 47 | (alexandria:ensure-list input-array))) 0)))) 48 | 49 | (defun tap.ar (&optional (bufnum 0) (chanls 1) (delay 0.2)) 50 | (let ((n (mul delay (neg (sample-rate.ir))))) 51 | (play-buf.ar chanls bufnum 1 :trig 0 :start-pos n :loop 1))) 52 | 53 | 54 | 55 | ;;; 56 | ;;; for LocalBuf 57 | ;;; 58 | 59 | (defun make-max-local-bufs () 60 | (ugen-new "MaxLocalBufs" :scalar 'ugen #'identity :bipolar 0)) 61 | 62 | (defun increment (max-local-bufs) 63 | (incf (nth 0 (inputs max-local-bufs)))) 64 | 65 | 66 | 67 | (defclass local-buf (width-first-ugen) 68 | ()) 69 | 70 | (defmethod frames ((buffer local-buf)) 71 | (nth 1 (inputs buffer))) 72 | 73 | (defmethod chanls ((buffer local-buf)) 74 | (nth 0 (inputs buffer))) 75 | 76 | (defmethod new1 ((ugen local-buf) &rest inputs) 77 | (let ((max-local-bufs (max-local-bufs (synthdef ugen)))) 78 | (unless max-local-bufs 79 | (setf max-local-bufs (make-max-local-bufs)) 80 | (setf (max-local-bufs (synthdef ugen)) max-local-bufs)) 81 | (increment max-local-bufs) 82 | (setf (inputs ugen) (append inputs (list max-local-bufs))) 83 | (add-to-synth ugen) 84 | (alexandria:appendf (width-first-ugens (synthdef ugen)) (list ugen)) 85 | ugen)) 86 | 87 | (defun local-buf (&optional (frames 1) (chanls 1)) 88 | (multinew 89 | (lambda (cls &rest inputs) (apply #'ugen-new "LocalBuf" :scalar cls #'identity :bipolar inputs)) 90 | 'local-buf 91 | chanls frames)) 92 | 93 | 94 | 95 | (defun set-buf (local-buf values &optional (offset 0)) 96 | (unless (every 'numberp (cons offset values)) 97 | (error "VALUES and OFFSET must all be numbers.")) 98 | (multinew-list (lambda (cls &rest inputs) (apply #'ugen-new "SetBuf" :scalar cls #'identity :bipolar inputs)) 99 | 'width-first-ugen 100 | (append (list local-buf offset (length values)) values))) 101 | 102 | (defun local-buf-list (values) 103 | (labels ((shape (list) 104 | (unless (or (every 'numberp list) 105 | (and (every 'listp list) 106 | (apply #'= (mapcar (lambda (obj) (length obj)) list)) 107 | (every #'identity 108 | (mapcar (lambda (obj) (every 'numberp obj)) list)))) 109 | (error "Invalid shape in local-buf-list.")) 110 | (if (every 'numberp list) (list (length list) 1) 111 | (list (length (car list)) (length list))))) 112 | (let ((buf (apply 'local-buf (shape values)))) 113 | (set-buf buf (alexandria:flatten (flop values))) 114 | buf))) 115 | 116 | (defun clear-buf (local-buf) 117 | (multinew (lambda (cls &rest inputs) (apply #'ugen-new "ClearBuf" :scalar cls #'identity :bipolar inputs)) 118 | 'width-first-ugen 119 | local-buf)) 120 | 121 | 122 | 123 | 124 | -------------------------------------------------------------------------------- /osc/lw-extension.lisp: -------------------------------------------------------------------------------- 1 | (in-package :sc-osc) 2 | 3 | ;;; JBJMC201309 4 | (defun single-float-bits (x) 5 | (declare (type single-float x)) 6 | (assert (= (float-radix x) 2)) 7 | (if (zerop x) 8 | (if (eql x 0.0f0) 0 #x-80000000) 9 | (multiple-value-bind (lisp-significand lisp-exponent lisp-sign) 10 | (integer-decode-float x) 11 | (assert (plusp lisp-significand)) 12 | ;; Calculate IEEE-style fields from Common-Lisp-style fields. 13 | ;; 14 | ;; KLUDGE: This code was written from my foggy memory of what IEEE 15 | ;; format looks like, augmented by some experiments with 16 | ;; the existing implementation of SINGLE-FLOAT-BITS, and what 17 | ;; I found floating around on the net at 18 | ;; , 19 | ;; , 20 | ;; and 21 | ;; . 22 | ;; And beyond the probable sheer flakiness of the code, all the bare 23 | ;; numbers floating around here are sort of ugly, too. -- WHN 19990711 24 | (let* ((significand lisp-significand) 25 | (exponent (+ lisp-exponent 23 127)) 26 | (unsigned-result 27 | (if (plusp exponent) ; if not obviously denormalized 28 | (do () 29 | (nil) 30 | (cond (;; special termination case, denormalized 31 | ;; float number 32 | (zerop exponent) 33 | ;; Denormalized numbers have exponent one 34 | ;; greater than the exponent field. 35 | (return (ash significand -1))) 36 | (;; ordinary termination case 37 | (>= significand (expt 2 23)) 38 | (assert (< 0 significand (expt 2 24))) 39 | ;; Exponent 0 is reserved for 40 | ;; denormalized numbers, and 255 is 41 | ;; reserved for specials like NaN. 42 | (assert (< 0 exponent 255)) 43 | (return (logior (ash exponent 23) 44 | (logand significand 45 | (1- (ash 1 23)))))) 46 | 47 | (t 48 | ;; Shift as necessary to set bit 24 of 49 | ;; significand. 50 | (setf significand (ash significand 1) 51 | exponent (1- exponent))))) 52 | (do () 53 | ((zerop exponent) 54 | ;; Denormalized numbers have exponent one 55 | ;; greater than the exponent field. 56 | (ash significand -1)) 57 | (unless (zerop (logand significand 1)) 58 | (warn "denormalized SINGLE-FLOAT-BITS ~S losing bits" 59 | x)) 60 | (setf significand (ash significand -1) 61 | exponent (1+ exponent)))))) 62 | (ecase lisp-sign 63 | (1 unsigned-result) 64 | (-1 (logior unsigned-result (- (expt 2 31))))))))) 65 | 66 | ;;; JBJMC201309 67 | (defun kludge-opaque-expt (x y) 68 | (expt x y)) 69 | 70 | ;;; JBJMC201309 71 | (defun make-single-float (bits) 72 | (cond 73 | ;; IEEE float special cases 74 | ((zerop bits) 0.0) 75 | ((= bits #x-80000000) -0.0) 76 | (t (let* ((sign (ecase (ldb (byte 1 31) bits) 77 | (0 1.0) 78 | (1 -1.0))) 79 | (iexpt (ldb (byte 8 23) bits)) 80 | (expt (if (zerop iexpt) ; denormalized 81 | -126 82 | (- iexpt 127))) 83 | (mant (* (logior (ldb (byte 23 0) bits) 84 | (if (zerop iexpt) 85 | 0 86 | (ash 1 23))) 87 | (expt 0.5 23)))) 88 | (* sign (kludge-opaque-expt 2.0 expt) mant))))) 89 | 90 | (defun osc::encode-float32 (f) 91 | "encode an ieee754 float as a 4 byte vector. currently sbcl/cmucl specifc" 92 | #+sbcl (encode-int32 (sb-kernel:single-float-bits f)) 93 | #+cmucl (encode-int32 (kernel:single-float-bits f)) 94 | #+openmcl (encode-int32 (CCL::SINGLE-FLOAT-BITS f)) 95 | #+allegro (encode-int32 (multiple-value-bind (x y) (excl:single-float-to-shorts f) 96 | (+ (ash x 16) y))) 97 | #+lispworks (osc::encode-int32 (single-float-bits f)) 98 | #-(or sbcl cmucl openmcl allegro lispworks) (error "cant encode floats using this implementation")) 99 | 100 | (defun osc::decode-float32 (s) 101 | "ieee754 float from a vector of 4 bytes in network byte order" 102 | #+sbcl (sb-kernel:make-single-float (decode-int32 s)) 103 | #+cmucl (kernel:make-single-float (decode-int32 s)) 104 | #+openmcl (CCL::HOST-SINGLE-FLOAT-FROM-UNSIGNED-BYTE-32 (decode-uint32 s)) 105 | #+allegro (excl:shorts-to-single-float (ldb (byte 16 16) (decode-int32 s)) 106 | (ldb (byte 16 0) (decode-int32 s))) 107 | #+lispworks (make-single-float (osc::decode-int32 s)) 108 | #-(or sbcl cmucl openmcl allegro lispworks) (error "cant decode floats using this implementation")) 109 | -------------------------------------------------------------------------------- /ugens/FSinOsc.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defugen (f-sin-osc "FSinOsc") 4 | (&optional (freq 440.0) (iphase 0.0) (mul 1.0) (add 0.0)) 5 | ((:ar 6 | (madd (multinew new 'ugen freq iphase) mul add)) 7 | (:kr 8 | (madd (multinew new 'ugen freq iphase) mul add)))) 9 | 10 | 11 | (defun flop-argument (lst type) 12 | (unless lst (setf lst (list (ecase type 13 | (:amps 1.0) 14 | (:times 1.0) 15 | (:phases 0.0))))) 16 | (flop lst)) 17 | 18 | (defclass klang (ugen) ()) 19 | 20 | (defmethod new1 ((ugen klang) &rest inputs) 21 | (destructuring-bind (freqscale freqoffset array-ref) inputs 22 | (setf (inputs ugen) 23 | (append (list freqscale freqoffset) 24 | (alexandria:flatten (loop for arr across array-ref collect (if (null arr) 1.0 arr))))) 25 | (add-to-synth ugen))) 26 | 27 | (defugen (klang "Klang") (specificationsArrayRef &optional (freq-scale 1.0) (freq-offset 0.0)) 28 | ((:ar (let ((len (length specificationsArrayRef))) 29 | (unless (= 3 len) 30 | (alexandria:appendf specificationsArrayRef (make-list (- 3 len))))) 31 | (multinew new 'klang freq-scale freq-offset 32 | (unbubble (mapcar #'(lambda (lst) (make-array (length lst) :initial-contents lst)) 33 | (lst-operation (mapcar #'flop-argument specificationsArrayRef 34 | (list :freqs :amps :phases))))))))) 35 | 36 | (defclass klank (ugen) ()) 37 | 38 | (defmethod new1 ((ugen klank) &rest inputs) 39 | (destructuring-bind (input freqscale freqoffset decayscale array-ref) inputs 40 | (setf (inputs ugen) 41 | (append (list input freqscale freqoffset decayscale) 42 | (alexandria:flatten (loop for arr across array-ref collect (if (null arr) 1.0 arr))))) 43 | (add-to-synth ugen))) 44 | 45 | (defugen (klank "Klank") (specificationsArrayRef input &optional (freq-scale 1.0) (freq-offset 0.0) (decay-scale 1.0)) 46 | ((:ar (let ((len (length specificationsArrayRef))) 47 | (unless (= 3 len) 48 | (alexandria:appendf specificationsArrayRef (make-list (- 3 len))))) 49 | (multinew new 'klank input freq-scale freq-offset decay-scale 50 | (unbubble (mapcar #'(lambda (lst) (make-array (length lst) :initial-contents lst)) 51 | (lst-operation (mapcar #'flop-argument specificationsArrayRef 52 | (list :freqs :amps :times))))))))) 53 | 54 | 55 | (defclass dyn-klank (ugen) ()) 56 | 57 | (defmethod new1 ((ugen dyn-klank) &rest inputs) 58 | (destructuring-bind (array-ref input freq-scale freq-offset decay-scale) inputs 59 | (let ((array-ref (map 'list #'identity array-ref))) 60 | (ecase (rate ugen) 61 | (:audio (sum (ringz.ar input (alexandria:if-let ((spec (nth 0 array-ref))) spec 62 | (add (mul (list 440.0) freq-scale) freq-offset)) 63 | (alexandria:if-let ((spec (nth 2 array-ref))) spec 64 | (mul (list 1.0) decay-scale)) 65 | (alexandria:if-let ((spec (nth 1 array-ref))) spec (list 1.0))))) 66 | (:control (sum (ringz.kr input (alexandria:if-let ((spec (nth 0 array-ref))) spec 67 | (add (mul (list 440.0) freq-scale) freq-offset)) 68 | (alexandria:if-let ((spec (nth 2 array-ref))) spec 69 | (mul (list 1.0) decay-scale)) 70 | (alexandria:if-let ((spec (nth 1 array-ref))) spec (list 1.0))))))))) 71 | 72 | (defugen (dyn-klank "DynKlank") 73 | (array-ref input &optional (freq-scale 1.0) (freq-offset 0.0) (decay-scale 1.0)) 74 | ((:ar (multinew new 'dyn-klank (make-array (length array-ref) :initial-contents array-ref) 75 | input freq-scale freq-offset decay-scale)) 76 | (:kr (multinew new 'dyn-klank (make-array (length array-ref) :initial-contents array-ref) 77 | input freq-scale freq-offset decay-scale)))) 78 | 79 | (defclass dyn-klang (ugen) ()) 80 | 81 | (defmethod new1 ((ugen dyn-klang) &rest inputs) 82 | (destructuring-bind (array-ref freq-scale freq-offset) inputs 83 | (let ((array-ref (map 'list #'identity array-ref))) 84 | (ecase (rate ugen) 85 | (:audio (sum (sin-osc.ar (alexandria:if-let ((spec (nth 0 array-ref))) spec 86 | (add (mul (list 440.0) freq-scale) freq-offset)) 87 | (alexandria:if-let ((spec (nth 2 array-ref))) spec (list 0.0)) 88 | (alexandria:if-let ((spec (nth 1 array-ref))) spec (list 1.0))))) 89 | (:control (sum (sin-osc.kr (alexandria:if-let ((spec (nth 0 array-ref))) spec 90 | (add (mul (list 440.0) freq-scale) freq-offset)) 91 | (alexandria:if-let ((spec (nth 2 array-ref))) spec (list 0.0)) 92 | (alexandria:if-let ((spec (nth 1 array-ref))) spec (list 1.0))))))))) 93 | 94 | (defugen (dyn-klang "DynKlang") 95 | (array-ref &optional (freq-scale 1.0) (freq-offset 0.0)) 96 | ((:ar (multinew new 'dyn-klang (make-array (length array-ref) :initial-contents array-ref) 97 | freq-scale freq-offset)) 98 | (:kr (multinew new 'dyn-klang (make-array (length array-ref) :initial-contents array-ref) 99 | freq-scale freq-offset)))) 100 | 101 | 102 | (defugen (blip "Blip") 103 | (&optional (freq 440.0) (num-harm 220.0) (mul 1.0) (add 0.0)) 104 | ((:ar 105 | (madd (multinew new 'ugen freq num-harm) mul add)) 106 | (:kr 107 | (madd (multinew new 'ugen freq num-harm) mul add)))) 108 | 109 | (defugen (saw "Saw") 110 | (&optional (freq 440.0) (mul 1.0) (add 0.0)) 111 | ((:ar (madd (multinew new 'ugen freq) mul add)) 112 | (:kr (madd (multinew new 'ugen freq) mul add)))) 113 | 114 | (defugen (pulse "Pulse") 115 | (&optional (freq 440.0) (width 0.5) (mul 1.0) (add 0.0)) 116 | ((:ar (madd (multinew new 'ugen freq width) mul add)) 117 | (:kr (madd (multinew new 'ugen freq width) mul add)))) 118 | 119 | -------------------------------------------------------------------------------- /ugens/Line.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defugen (line "Line") 4 | (&optional (start 0.0) (end 1.0) (dur 1.0) &key (mul 1.0) (add 0.0) (act :no-action)) 5 | ((:ar (madd (multinew new 'ugen start end dur (act act)) mul add)) 6 | (:kr (madd (multinew new 'ugen start end dur (act act)) mul add)))) 7 | 8 | (defugen (x-line "XLine") 9 | (&optional (start 1.0) (end 2.0) (dur 1.0) &key (mul 1.0) (add 0.0) (act :no-action)) 10 | ((:ar (madd (multinew new 'ugen start end dur (act act)) mul add)) 11 | (:kr (madd (multinew new 'ugen start end dur (act act)) mul add)))) 12 | 13 | 14 | 15 | (defun lin-lin.ar (in &optional (srclo 0.0) (srchi 1.0) (dstlo 1.0) (dsthi 2.0)) 16 | (let* ((scale (/~ (-~ dsthi dstlo) (-~ srchi srclo))) 17 | (offset (-~ dstlo (*~ scale srclo)))) 18 | (madd in scale offset))) 19 | 20 | (defun lin-lin.kr (in &optional (srclo 0.0) (srchi 1.0) (dstlo 1.0) (dsthi 2.0)) 21 | (let* ((scale (/~ (-~ dsthi dstlo) (-~ srchi srclo))) 22 | (offset (-~ dstlo (*~ scale srclo)))) 23 | (+~ (*~ in scale) offset))) 24 | 25 | (export '(lin-lin.ar lin-lin.kr)) 26 | 27 | (defun lin-lin (in in-min in-max out-min out-max &optional (clip :minmax)) 28 | (if (numberp in) (let* ((result (case clip 29 | (:minmax (cond ((<= in in-min) out-min) 30 | ((>= in in-max) out-max))) 31 | (:min (when (<= in in-min) out-min)) 32 | (:max (when (>= in in-max) out-max))))) 33 | (if result result 34 | (+ (* (/ (- in in-min) (- in-max in-min)) 35 | (- out-max out-min)) 36 | out-min))) 37 | (ecase (rate in) 38 | (:audio (lin-lin.ar (prune in in-min in-max clip) in-min in-max out-min out-max)) 39 | (:control (lin-lin.kr (prune in in-min in-max clip) in-min in-max out-min out-max))))) 40 | 41 | 42 | (defugen (lin-exp "LinExp") 43 | (&optional (in 0.0) (srclo 0.0) (srchi 1.0) (dstlo 1.0) (dsthi 2.0)) 44 | ((:ar (multinew new 'pure-ugen in srclo srchi dstlo dsthi)) 45 | (:kr (multinew new 'pure-ugen in srclo srchi dstlo dsthi))) 46 | :check-fn #'check-same-rate-as-first-input) 47 | 48 | (defun lin-exp (in in-min in-max out-min out-max &optional (clip :minmax)) 49 | (if (numberp in) (let* ((result (case clip 50 | (:minmax (cond ((<= in in-min) out-min) 51 | ((>= in in-max) out-max))) 52 | (:min (when (<= in in-min) out-min)) 53 | (:max (when (>= in in-max) out-max))))) 54 | (if result result 55 | (* (expt (/ out-max out-min) (/ (- in in-min) (- in-max in-min))) 56 | out-min))) 57 | (ecase (rate in) 58 | (:audio (lin-exp.ar (prune in in-min in-max clip) in-min in-max out-min out-max)) 59 | (:control (lin-exp.kr (prune in in-min in-max clip) in-min in-max out-min out-max))))) 60 | 61 | (defun exp-lin (in in-min in-max out-min out-max &optional (clip :minmax)) 62 | (if (numberp in) (let* ((result (case clip 63 | (:minmax (cond ((<= in in-min) out-min) 64 | ((>= in in-max) out-max))) 65 | (:min (when (<= in in-min) out-min)) 66 | (:max (when (>= in in-max) out-max))))) 67 | (if result result 68 | (+ (* (/ (log (/ in in-min)) (log (/ in-max in-min))) 69 | (- out-max out-min)) 70 | out-min))) 71 | (+~ (*~ (/~ (log~ (/~ (prune in in-min in-max clip) in-min)) 72 | (log~ (/~ in-max in-min))) 73 | (-~ out-max out-min)) 74 | out-min))) 75 | 76 | (defun exp-exp (in in-min in-max out-min out-max &optional (clip :minmax)) 77 | (if (numberp in) (let* ((result (case clip 78 | (:minmax (cond ((<= in in-min) out-min) 79 | ((>= in in-max) out-max))) 80 | (:min (when (<= in in-min) out-min)) 81 | (:max (when (>= in in-max) out-max))))) 82 | (if result result 83 | (* (expt (/ out-max out-min) (/ (log (/ in in-min)) (log (/ in-max in-min)))) 84 | out-min))) 85 | (*~ (expt~ (/~ out-max out-min) (/~ (log~ (/~ (prune in in-min in-max clip) in-min)) 86 | (log~ (/~ in-max in-min)))) 87 | out-min))) 88 | 89 | 90 | (defun when-audio-check-first-input (ugen) 91 | (when (eql (rate ugen) :audio) 92 | (check-same-rate-as-first-input ugen))) 93 | 94 | (defugen (amp-comp "AmpComp") (&optional (freq (midicps 60.0)) (root (midicps 60.0)) (exp 0.3333)) 95 | ((:ir (multinew new 'pure-ugen freq root exp)) 96 | (:ar (multinew new 'pure-ugen freq root exp)) 97 | (:kr (multinew new 'pure-ugen freq root exp))) 98 | :check-fn #'when-audio-check-first-input ) 99 | 100 | (defugen (amp-comp-a "AmpCompA") (&optional (freq 1000) (root 0.0) (min-amp 0.32) (root-amp 1.0)) 101 | ((:ir (multinew new 'pure-ugen freq root min-amp root-amp)) 102 | (:ar (multinew new 'pure-ugen freq root min-amp root-amp)) 103 | (:kr (multinew new 'pure-ugen freq root min-amp root-amp))) 104 | :check-fn #'when-audio-check-first-input) 105 | 106 | (defugen (k2a "K2A") (&optional (in 0.0)) 107 | ((:ar (multinew new 'pure-ugen in)))) 108 | 109 | (defugen (a2k "A2K") (&optional (in 0.0)) 110 | ((:kr (multinew new 'pure-ugen in)))) 111 | 112 | (defugen (t2k "T2K") (&optional (in 0.0)) 113 | ((:kr (multinew new 'pure-ugen in))) 114 | :check-fn #'when-audio-check-first-input) 115 | 116 | (defugen (t2a "T2A") (&optional (in 0.0) (offset 0.0)) 117 | ((:ar (multinew new 'pure-ugen in offset)))) 118 | 119 | 120 | (defugen (dc "DC") (&optional (in 0.0)) 121 | ((:ar (multinew new 'multiout-ugen 1 in)) 122 | (:kr (multinew new 'multiout-ugen 1 in)))) 123 | 124 | (defugen (silent "Silent") (&optional (chanls 1)) 125 | ((:ar (let ((sig (dc.ar 0))) 126 | new 127 | (if (= chanls 1) sig (dup sig chanls)))))) 128 | -------------------------------------------------------------------------------- /util.lisp: -------------------------------------------------------------------------------- 1 | ;;; simple utillity and wrap ccl & sbcl's function. 2 | (in-package #:sc) 3 | (named-readtables:in-readtable :sc) 4 | 5 | ;;; [1 2 3] == (list 1 2 3) 6 | (let ((rpar (get-macro-character #\)))) 7 | (set-macro-character #\] rpar) 8 | (set-macro-character #\[ (lambda (stream char1) 9 | (declare (ignore char1)) 10 | (apply (lambda (&rest rest) (cons 'list rest)) 11 | (read-delimited-list #\] stream t))))) 12 | 13 | (defun thread-wait (f) 14 | #+ccl (ccl:process-wait "wait.." f) 15 | #+lispworks (mp:process-wait "wait.." f) 16 | #+(or sbcl ecl) (or (apply f nil) 17 | (loop 18 | (when (apply f nil) 19 | (return)) 20 | (sleep .01)))) 21 | 22 | (defun thread-wait-with-timeout (f timeout-msec) 23 | #+ccl (ccl:process-wait-with-timeout "wait.." timeout-msec f) 24 | #+lispworks (mp:process-wait-with-timeout "wait.." (* timeout-msec 0.001) f) 25 | #+(or sbcl ecl) (let ((dead-time (+ (/ (get-internal-real-time) internal-time-units-per-second) 26 | (* 1e-3 timeout-msec)))) 27 | (cond ((apply f nil) t) 28 | (t (loop 29 | (alexandria:when-let ((val (apply f nil))) 30 | (return-from thread-wait-with-timeout val)) 31 | (when (> (/ (get-internal-real-time) internal-time-units-per-second) 32 | dead-time) 33 | (return)) 34 | (sleep .01)))))) 35 | 36 | (defun full-pathname (path) 37 | "Get the absolute pathname of PATH." 38 | (uiop:native-namestring (namestring (uiop:ensure-pathname path :want-non-wild t)))) 39 | 40 | (defun file-exists-p (filename) 41 | "True if FILENAME names a file that exists. This function is needed to ensure characters like ? are not interpreted as Common Lisp pathname wildcards." 42 | #-windows (probe-file (uiop:ensure-pathname filename :want-non-wild t)) 43 | #+windows (probe-file filename)) 44 | 45 | (defmethod cat ((sequence string) &rest sequences) 46 | (apply #'concatenate 'string sequence sequences)) 47 | 48 | (defmethod cat ((sequence list) &rest sequences) 49 | (apply #'append sequence sequences)) 50 | 51 | (defun sc-program-run (program options) 52 | #+lispworks (multiple-value-bind (res result-string) 53 | (sys:call-system-showing-output (format nil "~{~s ~}" (cons program options)) 54 | :output-stream nil) 55 | (if (zerop res) 56 | t 57 | (error "Failed to run program ~s with error code ~d and output ~s" 58 | program res result-string))) 59 | #+ecl 60 | (uiop:run-program (format nil "~{~s ~}" (cons program options)) 61 | :output :interactive) 62 | #-(or ecl lispworks) 63 | (uiop:run-program (cons program options) 64 | :output :interactive :error-output *debug-io*)) 65 | 66 | (defun as-keyword (object) 67 | (alexandria:make-keyword 68 | (etypecase object 69 | (symbol object) 70 | (string (string-upcase object))))) 71 | 72 | (defun nth-wrap (n list) 73 | "Get the Nth value of LIST, wrapping around if the value is bigger or smaller than the list length." 74 | (elt list (mod n (length list)))) 75 | 76 | (defun blend-nth (n list) 77 | "Get the Nth value of LIST, linearly interpolating between the adjacent values if N is not an integer." 78 | (if (= n (round n)) 79 | (elt list n) 80 | (let* ((floor (floor n)) 81 | (ceiling (ceiling n)) 82 | (fl-diff (- n floor))) 83 | (+ (* (elt list floor) (- 1 fl-diff)) 84 | (* (elt list ceiling) fl-diff))))) 85 | 86 | (defun linear-resample (sequence length) 87 | "Using linear interpolation, resample the values of SEQUENCE to a new list or vector of length LENGTH." 88 | (let ((old-length (length sequence))) 89 | (if (= old-length length) 90 | sequence 91 | (let ((factor (/ (1- old-length) (max (1- length) 1))) 92 | (res (etypecase sequence 93 | (list (make-list length)) 94 | (vector (make-array (list length)))))) 95 | (dotimes (i length res) 96 | (setf (elt res i) (blend-nth (* i factor) sequence))))))) 97 | 98 | ;; conditionally load swank extensions 99 | (eval-when (:compile-toplevel :load-toplevel :execute) 100 | (when (alexandria:featurep :swank) 101 | (load (asdf:system-relative-pathname :cl-collider "swank-extensions.lisp")))) 102 | 103 | ;; conditionally load slynk extensions 104 | (eval-when (:compile-toplevel :load-toplevel :execute) 105 | (when (alexandria:featurep :slynk) 106 | (load (asdf:system-relative-pathname :cl-collider "slynk-extensions.lisp")))) 107 | 108 | (defun write-mono-fl32-wav (stream sr sequence) 109 | "write sequence data to wave file." 110 | (write-sequence (flexi-streams:string-to-octets "RIFF") stream) 111 | (write-sequence (nreverse (osc::encode-int32 (+ 36 (* 4 (length sequence))))) stream) 112 | (write-sequence (flexi-streams:string-to-octets "WAVE") stream) 113 | (write-sequence (flexi-streams:string-to-octets "fmt ") stream) 114 | (write-sequence (nreverse (osc::encode-int32 16)) stream) 115 | (write-byte 3 stream) (write-byte 0 stream) 116 | (write-byte 1 stream) (write-byte 0 stream) 117 | (write-sequence (nreverse (osc::encode-int32 sr)) stream) 118 | (write-sequence (nreverse (osc::encode-int32 (* 4 sr))) stream) 119 | (write-byte 4 stream) (write-byte 0 stream) 120 | (write-byte 32 stream) (write-byte 0 stream) 121 | (write-sequence (flexi-streams:string-to-octets "data") stream) 122 | (write-sequence (nreverse (osc::encode-int32 (* 4 (length sequence)))) stream) 123 | (dotimes (i (length sequence)) 124 | (write-sequence (nreverse (osc::encode-float32 (float (elt sequence i) 1.0))) stream))) 125 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # cl-collider 2 | 3 | A [SuperCollider](http://supercollider.github.io) client for [Common Lisp](https://www.common-lisp.net). 4 | It is an experimental project, so changes to the API are possible. 5 | 6 | ## Videos: 7 | 8 | - [tempo-clock on cl-collider](https://youtu.be/3Lo7yyZcSzU) 9 | - [cl-collider on Windows 10](https://youtu.be/pCEfV4jOdUA) 10 | - [Tutorial](https://www.youtube.com/watch?v=JivNMDUqNQc) - Due to API changes, this video is deprecated. A new tutorial video is coming soon. 11 | - [Live Coding Demo 1](https://www.youtube.com/watch?v=xzTH_ZqaFKI) 12 | - [Live Coding Demo 2](https://www.youtube.com/watch?v=pZyuHjztARY) 13 | 14 | ## Dependencies: 15 | 16 | - [SuperCollider](http://supercollider.github.io) 17 | - [Quicklisp](http://www.quicklisp.org) 18 | - [Clozure CL](https://ccl.clozure.com/), [SBCL](http://www.sbcl.org), or [ECL](https://common-lisp.net/project/ecl/) 19 | - [JACK](https://jackaudio.org/) - Only on GNU/Linux and BSD distributions. 20 | - [net-tools](https://net-tools.sourceforge.io/) - On Windows, scsynth should bind to a port before sending a message to CL. 21 | 22 | ## Contributing: 23 | 24 | If you have your own additional libraries, please inform me; I will add them here. 25 | 26 | - [sc-extensions](https://github.com/byulparan/sc-extensions) - extension library 27 | - [bdef](https://github.com/defaultxr/bdef) - file/buffer management/convenience library 28 | - [cl-patterns](https://github.com/defaultxr/cl-patterns) - patterns/sequencing library 29 | - [collidxr](https://github.com/defaultxr/collidxr) - syntax sugar and conveniences 30 | - [sc-vst](https://github.com/byulparan/sc-vst) - VSTPlugin support library 31 | 32 | ## Usage: 33 | 34 | - package: `sc`, `sc-user` (use this package) 35 | - named-readtable: `sc` 36 | 37 | ```cl 38 | (ql:quickload :cl-collider) 39 | 40 | (in-package :sc-user) 41 | (named-readtables:in-readtable :sc) 42 | 43 | ;; please check *sc-synth-program*, *sc-plugin-paths*, and *sc-synthdefs-path* 44 | ;; if paths are different on your system, set these variables accordingly: 45 | ;; 46 | ;; (setf *sc-synth-program* "/path/to/scsynth") 47 | ;; (setf *sc-plugin-paths* (list "/path/to/plugin_path" "/path/to/extension_plugin_path")) 48 | ;; (setf *sc-synthdefs-path* "/path/to/synthdefs_path") 49 | 50 | ;; `*s*` defines the server for the entire session 51 | ;; functions may use it internally. 52 | 53 | (setf *s* (make-external-server "localhost" :port 48800)) 54 | (server-boot *s*) 55 | 56 | ;; in Linux, you may need to call this function 57 | #+linux 58 | (jack-connect) 59 | 60 | ;; Hack music 61 | (defvar *synth*) 62 | (setf *synth* (play (sin-osc.ar [320 321] 0 .2))) 63 | 64 | ;; Stop music 65 | (free *synth*) 66 | 67 | ;; Quit SuperCollider server 68 | (server-quit *s*) 69 | ``` 70 | 71 | ### Create SynthDef 72 | 73 | ```cl 74 | (defsynth sine-wave ((note 60)) 75 | (let* ((freq (midicps note)) 76 | (sig (sin-osc.ar [freq (+ freq 2)] 0 .2))) 77 | (out.ar 0 sig))) 78 | 79 | (setf *synth* (synth 'sine-wave)) 80 | (ctrl *synth* :note 72) 81 | (free *synth*) 82 | ``` 83 | 84 | ### Create Proxy 85 | 86 | ```cl 87 | (proxy :sinesynth 88 | (sin-osc.ar [440 441] 0 .2)) 89 | 90 | (proxy :sinesynth 91 | (with-controls ((lfo-speed 4)) 92 | (sin-osc.ar (* [440 441] (range (lf-pulse.ar [lfo-speed (+ lfo-speed .2)]) 0 1)) 0 .2)) 93 | :fade 8.0) 94 | 95 | (ctrl :sinesynth :lfo-speed 8) 96 | (ctrl :sinesynth :gate 0) 97 | ``` 98 | 99 | ### Create Musical Sequence 100 | 101 | ```cl 102 | (defsynth saw-synth ((note 60) (dur 4.0)) 103 | (let* ((env (env-gen.kr (env [0 .2 0] [(* dur .2) (* dur .8)]) :act :free)) 104 | (freq (midicps note)) 105 | (sig (lpf.ar (saw.ar freq env) (* freq 2)))) 106 | (out.ar 0 [sig sig]))) 107 | 108 | (defun make-melody (time n &optional (offset 0)) 109 | (when (> n 0) 110 | (at time (synth 'saw-synth :note (+ offset (alexandria:random-elt '(62 65 69 72))))) 111 | (let ((next-time (+ time (alexandria:random-elt '(0 1 2 1.5))))) 112 | (callback next-time #'make-melody next-time (- n 1) offset)))) 113 | 114 | (make-melody (quant 4) 16) 115 | (make-melody (+ 4 (quant 4)) 16 12) 116 | ``` 117 | 118 | ### Non-real-time Rendering to File 119 | 120 | ```cl 121 | (setf *synth-definition-mode* :load) 122 | 123 | ;; Redefine the saw-synth ugen 124 | ;; The SynthDef file will be written to the *sc-synthdefs-path* 125 | (defsynth saw-synth ((note 60) (dur 4.0)) 126 | (let* ((env (env-gen.kr (env [0 .2 0] [(* dur .2) (* dur .8)]) :act :free)) 127 | (freq (midicps note)) 128 | (sig (lpf.ar (saw.ar freq env) (* freq 2)))) 129 | (out.ar 0 [sig sig]))) 130 | 131 | ;; We can use a similar function to make a melody, but we don't need to schedule the callbacks 132 | (defun make-melody (time n &optional (offset 0)) 133 | (when (> n 0) 134 | (at time (synth 'saw-synth :note (+ offset (alexandria:random-elt '(62 65 69 72))))) 135 | (let ((next-time (+ time (alexandria:random-elt '(0 1 2 1.5))))) 136 | (make-melody next-time (- n 1) offset)))) 137 | 138 | ;; Render audio file 139 | (with-rendering ("~/Desktop/foo.aiff" :pad 60) 140 | (make-melody 0.0d0 32) 141 | (make-melody 8.0d0 32 12) 142 | (make-melody 16.0d0 32 24)) 143 | ``` 144 | 145 | ### Record Audio Output 146 | 147 | ```cl 148 | ;;; write a single channel to disk 149 | 150 | ;; we can write to buffer number out_buf_num by reading from the 0 bus 151 | (defsynth disk_writer ((out_buf_num 99)) 152 | (disk-out.ar out_buf_num (in.ar 0))) 153 | 154 | (setf mybuffer (buffer-alloc (expt 2 17))) 155 | mybuffer 156 | 157 | ;; start a disk_writer synth 158 | (setf writer_0 (synth 'disk_writer)) 159 | 160 | ;; make it output to the buffer you allocated 161 | (ctrl writer_0 :out_buf_num (bufnum mybuffer)) 162 | 163 | ;; continuously write the buffer contents to a file 164 | (buffer-write mybuffer "/tmp/foo.aiff" :leave-open-p t) 165 | 166 | ;; now play whatever sounds you like 167 | 168 | ;; e.g. 169 | (proxy :blah (sin-osc.ar 440)) 170 | (free :blah) 171 | 172 | ;; then when you are done: 173 | 174 | ;; stop the disk_writer synth 175 | (free writer_0) 176 | 177 | ;; close and free the buffer 178 | (buffer-close mybuffer) 179 | (buffer-free mybuffer) 180 | 181 | ;; then you can play what you recorded with a utility like mpv: 182 | ;; mpv /tmp/foo.aiff 183 | ``` 184 | -------------------------------------------------------------------------------- /ugens/Delays.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defun as-audio-rate-input (input) 4 | "Return an audio rate version of INPUT if it is not already audio rate." 5 | (let ((op (lambda (cls in) 6 | (declare (ignore cls)) 7 | (if (eql :audio (rate in)) in 8 | (k2a.ar in))))) 9 | (multinew op nil input))) 10 | 11 | (defugen (Delay-1 "Delay1") (&optional (in 0.0) (mul 1.0) (add 0.0)) 12 | ((:ar (madd (multinew new 'pure-ugen in) mul add)) 13 | (:kr (madd (multinew new 'pure-ugen in) mul add)))) 14 | 15 | (defugen (Delay-2 "Delay2") (&optional (in 0.0) (mul 1.0) (add 0.0)) 16 | ((:ar (madd (multinew new 'pure-ugen in) mul add)) 17 | (:kr (madd (multinew new 'pure-ugen in) mul add)))) 18 | 19 | 20 | (defugen (delay-n "DelayN") 21 | (&optional (in 0.0) (max-delay-time 0.2) (delay-time 0.2) (mul 1.0) (add 0.0)) 22 | ((:ar (madd (multinew new 'pure-ugen (as-audio-rate-input in) max-delay-time delay-time) mul add)) 23 | (:kr (madd (multinew new 'pure-ugen in max-delay-time delay-time) mul add)))) 24 | 25 | (defugen (delay-l "DelayL") 26 | (&optional (in 0.0) (max-delay-time 0.2) (delay-time 0.2) (mul 1.0) (add 0.0)) 27 | ((:ar (madd (multinew new 'pure-ugen (as-audio-rate-input in) max-delay-time delay-time) mul add)) 28 | (:kr (madd (multinew new 'pure-ugen in max-delay-time delay-time) mul add)))) 29 | 30 | (defugen (delay-c "DelayC") 31 | (&optional (in 0.0) (max-delay-time 0.2) (delay-time 0.2) (mul 1.0) (add 0.0)) 32 | ((:ar (madd (multinew new 'pure-ugen (as-audio-rate-input in) max-delay-time delay-time) mul add)) 33 | (:kr (madd (multinew new 'pure-ugen in max-delay-time delay-time) mul add)))) 34 | 35 | (defugen (comb-n "CombN") 36 | (&optional (in 0.0) (max-delay-time 0.2) (delay-time 0.2) (decay-time 1.0) (mul 1.0) (add 0.0)) 37 | ((:ar (madd (multinew new 'pure-ugen (as-audio-rate-input in) max-delay-time delay-time decay-time) mul add)) 38 | (:kr (madd (multinew new 'pure-ugen in max-delay-time delay-time decay-time) mul add)))) 39 | 40 | (defugen (comb-l "CombL") 41 | (&optional (in 0.0) (max-delay-time 0.2) (delay-time 0.2) (decay-time 1.0) (mul 1.0) (add 0.0)) 42 | ((:ar (madd (multinew new 'pure-ugen (as-audio-rate-input in) max-delay-time delay-time decay-time) mul add)) 43 | (:kr (madd (multinew new 'pure-ugen in max-delay-time delay-time decay-time) mul add)))) 44 | 45 | (defugen (comb-c "CombC") 46 | (&optional (in 0.0) (max-delay-time 0.2) (delay-time 0.2) (decay-time 1.0) (mul 1.0) (add 0.0)) 47 | ((:ar (madd (multinew new 'pure-ugen (as-audio-rate-input in) max-delay-time delay-time decay-time) mul add)) 48 | (:kr (madd (multinew new 'pure-ugen in max-delay-time delay-time decay-time) mul add)))) 49 | 50 | (defugen (allpass-n "AllpassN") 51 | (&optional (in 0.0) (max-delay-time 0.2) (delay-time 0.2) (decay-time 1.0) (mul 1.0) (add 0.0)) 52 | ((:ar (madd (multinew new 'pure-ugen (as-audio-rate-input in) max-delay-time delay-time decay-time) mul add)) 53 | (:kr (madd (multinew new 'pure-ugen in max-delay-time delay-time decay-time) mul add)))) 54 | 55 | (defugen (allpass-l "AllpassL") 56 | (&optional (in 0.0) (max-delay-time 0.2) (delay-time 0.2) (decay-time 1.0) (mul 1.0) (add 0.0)) 57 | ((:ar (madd (multinew new 'pure-ugen (as-audio-rate-input in) max-delay-time delay-time decay-time) mul add)) 58 | (:kr (madd (multinew new 'pure-ugen in max-delay-time delay-time decay-time) mul add)))) 59 | 60 | (defugen (allpass-c "AllpassC") 61 | (&optional (in 0.0) (max-delay-time 0.2) (delay-time 0.2) (decay-time 1.0) (mul 1.0) (add 0.0)) 62 | ((:ar (madd (multinew new 'pure-ugen (as-audio-rate-input in) max-delay-time delay-time decay-time) mul add)) 63 | (:kr (madd (multinew new 'pure-ugen in max-delay-time delay-time decay-time) mul add)))) 64 | 65 | (defugen (buf-delay-n "BufDelayN") 66 | (&optional (buf 0) (in 0.0) (delay 0.2) (mul 1.0) (add 0.0)) 67 | ((:ar (madd (multinew new 'pure-ugen buf (as-audio-rate-input in) delay) mul add)) 68 | (:kr (madd (multinew new 'pure-ugen buf in delay) mul add)))) 69 | 70 | (defugen (buf-delay-l "BufDelayL") 71 | (&optional (buf 0) (in 0.0) (delay 0.2) (mul 1.0) (add 0.0)) 72 | ((:ar (madd (multinew new 'pure-ugen buf (as-audio-rate-input in) delay) mul add)) 73 | (:kr (madd (multinew new 'pure-ugen buf in delay) mul add)))) 74 | 75 | (defugen (buf-delay-c "BufDelayC") 76 | (&optional (buf 0) (in 0.0) (delay 0.2) (mul 1.0) (add 0.0)) 77 | ((:ar (madd (multinew new 'pure-ugen buf (as-audio-rate-input in) delay) mul add)) 78 | (:kr (madd (multinew new 'pure-ugen buf in delay) mul add)))) 79 | 80 | (defugen (buf-comb-n "BufCombN") 81 | (&optional (buf 0) (in 0.0) (delay 0.2) (decay 1.0) (mul 1.0) (add 0.0)) 82 | ((:ar (madd (multinew new 'pure-ugen buf (as-audio-rate-input in) delay decay) mul add)))) 83 | 84 | (defugen (buf-comb-l "BufCombL") 85 | (&optional (buf 0) (in 0.0) (delay 0.2) (decay 1.0) (mul 1.0) (add 0.0)) 86 | ((:ar (madd (multinew new 'pure-ugen buf (as-audio-rate-input in) delay decay) mul add)))) 87 | 88 | (defugen (buf-comb-c "BufCombC") 89 | (&optional (buf 0) (in 0.0) (delay 0.2) (decay 1.0) (mul 1.0) (add 0.0)) 90 | ((:ar (madd (multinew new 'pure-ugen buf (as-audio-rate-input in) delay decay) mul add)))) 91 | 92 | (defugen (buf-allpass-n "BufAllpassN") 93 | (&optional (buf 0) (in 0.0) (delay 0.2) (decay 1.0) (mul 1.0) (add 0.0)) 94 | ((:ar (madd (multinew new 'pure-ugen buf (as-audio-rate-input in) delay decay) mul add)))) 95 | 96 | (defugen (buf-allpass-l "BufAllpassL") 97 | (&optional (buf 0) (in 0.0) (delay 0.2) (decay 1.0) (mul 1.0) (add 0.0)) 98 | ((:ar (madd (multinew new 'pure-ugen buf (as-audio-rate-input in) delay decay) mul add)))) 99 | 100 | (defugen (buf-allpass-c "BufAllpassC") 101 | (&optional (buf 0) (in 0.0) (delay 0.2) (decay 1.0) (mul 1.0) (add 0.0)) 102 | ((:ar (madd (multinew new 'pure-ugen buf (as-audio-rate-input in) delay decay) mul add)))) 103 | 104 | 105 | (defugen (deltap-wr "DelTapWr") (&optional (buf 0) (in 0)) 106 | ((:ar (multinew new 'ugen buf in)) 107 | (:kr (multinew new 'ugen buf in)))) 108 | 109 | (defugen (deltap-rd "DelTapRd") (&optional buf phase deltime &key (interp 1) 110 | (mul 1) (add 0)) 111 | ((:ar (madd (multinew new 'ugen buf phase deltime interp) mul add)) 112 | (:kr (madd (multinew new 'ugen buf phase deltime interp) mul add)))) 113 | -------------------------------------------------------------------------------- /osc/transmit.lisp: -------------------------------------------------------------------------------- 1 | (in-package :sc-osc) 2 | 3 | (defclass osc-device () 4 | ((reply-handle-table 5 | :initform (make-hash-table :test #'equal) 6 | :reader reply-handle-table) 7 | (debug-msg 8 | :initarg :debug-msg 9 | :accessor debug-msg) 10 | (host 11 | :initarg :host 12 | :reader host) 13 | (port 14 | :initarg :port 15 | :reader port) 16 | (status 17 | :initform :not-running 18 | :accessor status) 19 | (socket 20 | :initarg :socket 21 | :reader socket) 22 | (listening-thread 23 | :initform nil 24 | :accessor listening-thread) 25 | (local-port 26 | :initarg :local-port 27 | :reader local-port))) 28 | 29 | 30 | (defun osc-device (host port &key (local-host "0.0.0.0") local-port debug-msg) 31 | (let ((device (make-instance 'osc-device 32 | :host host 33 | :port port 34 | :debug-msg debug-msg 35 | :socket (usocket:socket-connect nil nil 36 | :protocol :datagram 37 | :local-host local-host 38 | :local-port local-port)))) 39 | #+sbcl (setf (sb-bsd-sockets:sockopt-send-buffer (usocket:socket (socket device))) 40 | usocket:+max-datagram-packet-size+) 41 | #+(or ccl lispworks) 42 | (let* ((sol-socket #+linux 1 #-linux #xffff) 43 | (so-sndbuf #+linux 7 #-linux #x1001)) 44 | (let ((result #+ccl (ccl::int-setsockopt (ccl:socket-os-fd (usocket:socket (socket device))) 45 | sol-socket so-sndbuf 46 | usocket:+max-datagram-packet-size+) 47 | #+lispworks (cffi:with-foreign-objects ((max-len :int)) 48 | (setf (cffi:mem-ref max-len :int) usocket:+max-datagram-packet-size+) 49 | (cffi:foreign-funcall "setsockopt" :int (usocket:socket (socket device)) 50 | :int sol-socket 51 | :int so-sndbuf 52 | :pointer max-len 53 | :int 4 54 | :int)))) 55 | (assert (zerop result) nil "fail increase socket sndbuf"))) 56 | (when local-port 57 | (setf (listening-thread device) (make-listening-thread device))) 58 | (setf (status device) :running) 59 | device)) 60 | 61 | (defun add-osc-responder (osc-device cmd-name f) 62 | (setf (gethash cmd-name (reply-handle-table osc-device)) f)) 63 | 64 | (defun remove-osc-responder (osc-device cmd-name) 65 | (remhash cmd-name (reply-handle-table osc-device))) 66 | 67 | (defun send-message (osc-device &rest message) 68 | (let ((msg (apply #'encode-message message))) 69 | (usocket:socket-send (socket osc-device) msg (length msg) 70 | :port (port osc-device) 71 | :host (host osc-device)) 72 | (values))) 73 | 74 | (defun send-bundle (timestamp osc-device &rest messages) 75 | (let ((msg (encode-bundle messages timestamp))) 76 | (usocket:socket-send (socket osc-device) msg (length msg) 77 | :port (port osc-device) 78 | :host (host osc-device)) 79 | (values))) 80 | 81 | (defun close-device (osc-device) 82 | (assert (eql (status osc-device) :running) nil "~a not running" osc-device) 83 | (let* ((socket (socket osc-device))) 84 | (when (listening-thread osc-device) 85 | (let* ((msg (encode-message "/done" "/quit"))) 86 | (usocket:socket-send socket msg (length msg) 87 | :host "127.0.0.1" 88 | :port (usocket:get-local-port socket))) 89 | (bt:join-thread (listening-thread osc-device))) 90 | (usocket:socket-close (socket osc-device))) 91 | (setf (status osc-device) :not-running)) 92 | 93 | (defparameter *debugging-make-listening-thread* nil) 94 | 95 | (defun make-listening-thread (osc-device) 96 | (bt:make-thread 97 | (lambda () 98 | (setf *random-state* (make-random-state t)) 99 | (let ((running-p t) 100 | #+lispworks(starting-calls 100) 101 | (buffer (make-array usocket:+max-datagram-packet-size+ :element-type '(unsigned-byte 8)))) 102 | (loop while running-p 103 | do 104 | #+ecl (setf buffer (make-array usocket:+max-datagram-packet-size+ :element-type '(unsigned-byte 8))) ;; maybe This is ECL/USocket bug 105 | (multiple-value-bind (buffer length host port) 106 | #+lispworks 107 | (if (> starting-calls 0) 108 | (progn (decf starting-calls) 109 | (ignore-errors 110 | (usocket:socket-receive (socket osc-device) buffer (length buffer)))) 111 | (usocket:socket-receive (socket osc-device) buffer (length buffer))) 112 | #-lispworks (usocket:socket-receive (socket osc-device) buffer (length buffer)) 113 | (declare (ignore host port)) 114 | (if buffer ; nil when some error inside usocket:socket-receive was caught by the ignore-errors. 115 | (let* ((messages (cdr (decode-bundle buffer)))) 116 | (loop for message in messages 117 | for handler = (gethash (car message) (reply-handle-table osc-device)) 118 | do (if handler (handler-case (progn (apply handler (cdr message)) 119 | (when (and (string= (car message) "/done") 120 | (string= (second message) "/quit")) 121 | (setf running-p nil) 122 | (return))) 123 | (error (c) (format t "Error ~a on received message ~s ~%" c (car message)))) 124 | (if (and (string= (car message) "/done") 125 | (string= (second message) "/quit")) 126 | (progn 127 | (setf running-p nil) 128 | (return)) 129 | (when (debug-msg osc-device) 130 | (format t "Reply handler not found: ~a [ ~{~a ~}]~%" (car message) (cdr message))))))) 131 | ;; We reach here if we get an error during the first 100 calls. We assume the server not 132 | ;; ready yet, so just sleep a little and try again. 133 | (progn 134 | (when *debugging-make-listening-thread* 135 | (format t " make-listening-thread thread sleeping, error is : ~a~%" length)) 136 | (sleep 0.2))))))) 137 | :name (format nil "OSC device receive thread"))) 138 | -------------------------------------------------------------------------------- /ugens/SC3plugins/SLUGens.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defugen (sort-buf "SortBuf") 4 | (&optional (bufnum 0.0) (sortrate 10.0) (reset 0.0)) 5 | ((:ar (multinew new 'ugen bufnum sortrate reset)))) 6 | 7 | (defugen (gravity-grid "GravityGrid") 8 | (&optional (reset 0.0) (rate 0.1) (newx 0.0) (newy 0.0) bufnum (mul 1.0) (add 0.0)) 9 | ((:ar (madd (multinew new 'ugen reset rate newx newy (if bufnum bufnum -1)) mul add)))) 10 | 11 | (defugen (gravity-grid2 "GravityGrid2") 12 | (&optional (reset 0.0) (rate 0.1) (newx 0.0) (newy 0.0) bufnum (mul 1.0) (add 0.0)) 13 | ((:ar (madd (multinew new 'ugen reset rate newx newy bufnum) mul add)))) 14 | 15 | (defugen (breakcore "Breakcore") 16 | (&optional (bufnum 0.0) capturein capturetrigger (duration 0.1) ampdropout) 17 | ((:ar (multinew new 'ugen bufnum capturein capturetrigger duration ampdropout)))) 18 | 19 | (defugen (max "Max") 20 | (in &optional (numsamp 64)) 21 | ((:kr (multinew new 'ugen in numsamp)))) 22 | 23 | (defugen (print-val "PrintVal") 24 | (in &optional (numblocks 100) (id 0.0)) 25 | ((:kr (multinew new 'ugen in numblocks id)))) 26 | 27 | (defugen (env-detect "EnvDetect") 28 | (in &optional (attack 100) (release 0)) 29 | ((:ar (multinew new 'ugen in attack release))) 30 | :check-fn #'check-same-rate-as-first-input) 31 | 32 | (defugen (fitz-hugh-nagumo "FitzHughNagumo") 33 | (&optional (reset 0.0) (rateu 0.01) (ratew 0.01) (b0 1.0) (b1 1.0) (initu 0.0) (initw 0.0) (mul 1.0) (add 0.0)) 34 | ((:ar (madd (multinew new 'ugen reset rateu ratew b0 b1 initu initw) mul add)))) 35 | 36 | (defugen (double-well "DoubleWell") 37 | (&optional (reset 0.0) (ratex 0.01) (ratey 0.01) (f 1.0) (w 0.001) (delta 1.0) (initx 0.0) (inity 0.0) (mul 1.0) (add 0.0)) 38 | ((:ar (madd (multinew new 'ugen reset ratex ratey f w delta initx inity) mul add)))) 39 | 40 | (defugen (double-well2 "DoubleWell2") 41 | (&optional (reset 0.0) (ratex 0.01) (ratey 0.01) (f 1.0) (w 0.001) (delta 1.0) (initx 0.0) (inity 0.0) (mul 1.0) (add 0.0)) 42 | ((:ar (madd (multinew new 'ugen reset ratex ratey f w delta initx inity) mul add)))) 43 | 44 | (defugen (double-well3 "DoubleWell3") 45 | (&optional (reset 0.0) (rate 0.01) (f 0.0) (delta 0.25) (initx 0.0) (inity 0.0) (mul 1.0) (add 0.0)) 46 | ((:ar (madd (multinew new 'ugen reset rate f delta initx inity) mul add)))) 47 | 48 | (defugen (weakly-nonlinear "WeaklyNonlinear") 49 | (input &optional (reset 0.0) (ratex 1.0) (ratey 1.0) (freq 440.0) (initx 0.0) (inity 0.0) (alpha 0.0) (xexponent 0.0) 50 | (beta 0.0) (yexponent 0.0) (mul 1.0) (add 0.0)) 51 | ((:ar (madd (multinew new 'ugen input reset ratex ratey freq initx inity alpha xexponent beta yexponent) mul add)))) 52 | 53 | (defugen (weakly-nonlinear2 "WeaklyNonlinear2") 54 | (input &optional (reset 0.0) (ratex 1.0) (ratey 1.0) (freq 440.0) (initx 0.0) (inity 0.0) (alpha 0.0) (xexponent 0.0) 55 | (beta 0.0) (yexponent 0.0) (mul 1.0) (add 0.0)) 56 | ((:ar (madd (multinew new 'ugen input reset ratex ratey freq initx inity alpha xexponent beta yexponent) mul add)))) 57 | 58 | (defugen (terman-wang "TermanWang") 59 | (&optional (input 0.0) (reset 0.0) (ratex 0.01) (ratey 0.01) (alpha 1.0) (beta 1.0) (eta 1.0) (initx 0.0) (inity 0.0) 60 | (mul 1.0) (add 0.0)) 61 | ((:ar (madd (multinew new 'ugen input reset ratex ratey alpha beta eta initx inity) mul add)))) 62 | 63 | (defugen (lti "LTI") 64 | (input &optional (bufnuma 0.0) (bufnumb 1.0) (mul 1.0) (add 0.0)) 65 | ((:ar (madd (multinew new 'ugen input bufnuma bufnumb) mul add)))) 66 | 67 | (defugen (nl "NL") 68 | (input &optional (bufnuma 0.0) (bufnumb 1.0) (guard1 1000.0) (guard2 100.0) (mul 1.0) (add 0.0)) 69 | ((:ar (madd (multinew new 'ugen input bufnuma bufnumb guard1 guard2) mul add)))) 70 | 71 | (defugen (nl2 "NL2") 72 | (input &optional (bufnum 0.0) (maxsizea 10.0) (maxsizeb 10.0) (guard1 1000.0) (guard2 100.0) (mul 1.0) (add 0.0)) 73 | ((:ar (madd (multinew new 'ugen input bufnum maxsizea maxsizeb guard1 guard2) mul add)))) 74 | 75 | (defugen (lpc-error "LPCError") 76 | (input &optional (p 10.0) (mul 1.0) (add 0.0)) 77 | ((:ar (madd (multinew new 'ugen input p) mul add)))) 78 | 79 | (defugen (kmeans-to-bpset1 "KmeansToBPSet1") 80 | (&optional (freq 440.0) (numdatapoints 20.0) (maxnummeans 4.0) (nummeans 4.0) (tnewdata 1.0) (tnewmeans 1.0) 81 | (soft 1.0) bufnum (mul 1.0) (add 0.0)) 82 | ((:ar (madd (multinew new 'ugen freq numdatapoints maxnummeans nummeans tnewdata tnewmeans soft (if bufnum bufnum -1)) mul add)))) 83 | 84 | (defugen (instruction "Instruction") 85 | (&optional (bufnum 0.0) (mul 1.0) (add 0.0)) 86 | ((:ar (madd (multinew new 'ugen bufnum) mul add)))) 87 | 88 | (defugen (wave-terrain "WaveTerrain") 89 | (&optional (bufnum 0.0) x y (xsize 100.0) (ysize 100.0) (mul 1.0) (add 0.0)) 90 | ((:ar (madd (multinew new 'ugen bufnum x y xsize ysize) mul add)))) 91 | 92 | (defugen (vm-scan2d "VMScan2D") 93 | (&optional (bufnum 0.0) (mul 1.0) (add 0.0)) 94 | ((:ar (madd (multinew new 'multiout-ugen 2 bufnum) mul add)))) 95 | 96 | (defugen (sl-onset "SLOnset") 97 | (input &optional (memorysize1 20.0) (before 5.0) (after 5.0) (threshold 10.0) (hysteresis 10.0) (mul 1.0) (add 0.0)) 98 | ((:ar (madd (multinew new 'ugen input memorysize1 before after threshold hysteresis) mul add)))) 99 | 100 | (defugen (two-tube "TwoTube") 101 | (&optional (input 0.0) (k 0.01) (loss 1.0) (d1length 100.0) (d2length 100.0) (mul 1.0) (add 0.0)) 102 | ((:ar (madd (multinew new 'ugen input k loss d1length d2length) mul add)))) 103 | 104 | ;; NTube 105 | 106 | (defugen (env-follow "EnvFollow") 107 | (&optional (in 0.0) (decaycoeff 0.99) (mul 1.0) (add 0.0)) 108 | ((:ar (madd (multinew new 'ugen in decaycoeff) mul add)) 109 | (:kr (madd (multinew new 'ugen in decaycoeff) mul add)))) 110 | 111 | (defugen (sieve1 "Sieve1") 112 | (bufnum &optional (gap 2.0) (alternate 1.0) (mul 1.0) (add 0.0)) 113 | ((:ar (madd (multinew new 'ugen bufnum gap alternate) mul add)) 114 | (:kr (madd (multinew new 'ugen bufnum gap alternate) mul add) ))) 115 | 116 | (defugen (oregonator "Oregonator") 117 | (&optional (reset 0.0) (rate 0.01) (epsilon 1.0) (mu 1.0) (q 1.0) (initx 0.5) (inity 0.5) (initz 0.5) 118 | (mul 1.0) (add 0.0)) 119 | ((:ar (madd (multinew new 'multiout-ugen 3 reset rate epsilon mu q initx inity initz) mul add)))) 120 | 121 | (defugen (brusselator "Brusselator") 122 | (&optional (reset 0.0) (rate 0.01) (mu 1.0) (gamma 1.0) (initx 0.5) (inity 0.5) (mul 1.0) (add 0.0)) 123 | ((:ar (madd (multinew new 'multiout-ugen 2 reset rate mu gamma initx inity) mul add)))) 124 | 125 | (defugen (spruce-budworm "SpruceBudworm") 126 | (&optional (reset 0.0) (rate 0.1) (k1 27.9) (k2 1.5) (alpha 0.1) (beta 10.1) (mu 0.3) (rho 10.1) 127 | (initx 0.9) (inity 0.1) (mul 1.0) (add 0.0)) 128 | ((:ar (madd (multinew new 'multiout-ugen 2 reset rate k1 k2 alpha beta mu rho initx inity) mul add)))) 129 | 130 | 131 | -------------------------------------------------------------------------------- /osc/osc.lisp: -------------------------------------------------------------------------------- 1 | ;;; 2 | ;;; This is extension of cl-osc(in Quicklisp). 3 | ;;; SuperCollider use some non-standard OSC functions, so support it. 4 | ;;; 5 | 6 | (in-package :sc-osc) 7 | 8 | (defun cat (&rest catatac) 9 | "original function in cl-osc that return just vector type. but datagram socket is use (vector (unsigned 8))." 10 | (apply #'concatenate '(vector (unsigned-byte 8)) catatac)) 11 | 12 | (defvar *immediate-timetag* (map '(vector (unsigned-byte 8)) #'identity (list 0 0 0 0 0 0 0 1))) 13 | (defconstant +2^32+ (expt 2 32)) 14 | 15 | (deftype timetag () '(unsigned-byte 64)) 16 | 17 | (defun timetagp (object) 18 | (typep object 'timetag)) 19 | 20 | 21 | ;;; encode osc ------------------------------------------------------------ 22 | 23 | (defun encode-float64 (f) 24 | (osc::encode-int64 (ieee-floats:encode-float64 f))) 25 | 26 | (defun encode-int16 (i) 27 | (subseq (osc::encode-int32 i) 2)) 28 | 29 | (defun sc-encode-blob (blob) 30 | (let* ((bl (length blob)) 31 | (mod-length (mod bl 4)) 32 | (padding-length (if (zerop mod-length) 0 (- 4 mod-length)))) 33 | (osc::cat (osc::encode-int32 bl) blob 34 | (osc::pad padding-length)))) 35 | 36 | (defmethod sc-encode-address ((address string)) 37 | (cat (map 'vector #'char-code address) 38 | (osc::string-padding address))) 39 | 40 | (defmethod sc-encode-address ((address integer)) 41 | (osc::encode-int32 address)) 42 | 43 | (defun sc-make-type-tags (datas) 44 | (labels ((rec (data) 45 | (typecase data 46 | (integer #\i) 47 | (double-float #\d) 48 | (float #\f) 49 | (simple-string #\s) 50 | (t #\b)))) 51 | (let ((result nil)) 52 | (dolist (i datas result) 53 | (if (listp i) (setf result (append result (list #\[) (sc-make-type-tags i) (list #\]))) 54 | (setf result (append result (list (rec i))))))))) 55 | 56 | (defun sc-encode-typetags (data) 57 | (let ((lump (make-array 0 :adjustable t 58 | :element-type '(unsigned-byte 8) 59 | :fill-pointer t))) 60 | (macrolet ((write-to-vector (char) 61 | `(vector-push-extend 62 | (char-code ,char) lump))) 63 | (write-to-vector #\,) 64 | (dolist (x (sc-make-type-tags data)) 65 | (write-to-vector x))) 66 | (cat lump 67 | (osc::pad (osc::padding-length (length lump)))))) 68 | 69 | 70 | (defun sc-encode-data (data) 71 | (let ((lump (make-array 0 :adjustable t :fill-pointer t :element-type '(unsigned-byte 8)))) 72 | (macrolet ((enc (f) 73 | `(setf lump (cat lump (,f x))))) 74 | (dolist (x (alexandria:flatten data)) 75 | (typecase x 76 | (integer (enc osc::encode-int32)) 77 | (double-float (enc encode-float64)) 78 | (float (enc osc::encode-float32)) 79 | (simple-string (enc osc::encode-string)) 80 | (t (enc sc-encode-blob)))) 81 | lump))) 82 | 83 | 84 | (defun encode-message (address &rest data) 85 | (concatenate '(vector (unsigned-byte 8)) 86 | (sc-encode-address address) 87 | (sc-encode-typetags data) 88 | (sc-encode-data data))) 89 | 90 | 91 | 92 | (defun sc-encode-timetag (timetag) 93 | (cond 94 | ((equalp timetag :now) 95 | #(0 0 0 0 0 0 0 1)) 96 | ((timetagp timetag) 97 | (osc::encode-int64 timetag)) 98 | (t (error "Argument given is not one of :now, or timetagp.")))) 99 | 100 | 101 | (defun encode-bundle (data &optional timetag) 102 | (flet ((encode-bundle-elt (data) 103 | (let ((message (apply #'encode-message data))) 104 | (cat (osc::encode-int32 (length message)) message)))) 105 | (cat '(35 98 117 110 100 108 101 0) 106 | (if timetag 107 | (sc-encode-timetag timetag) 108 | (sc-encode-timetag :now)) 109 | (if (listp (car data)) 110 | (apply #'cat (mapcar #'encode-bundle-elt data)) 111 | (encode-bundle-elt data))))) 112 | 113 | ;;; decode osc ------------------------------------------------------------ 114 | 115 | 116 | 117 | ;; this code from legacy osc package. 118 | (defun decode-uint64 (s) 119 | "8 byte -> 64 bit unsigned int" 120 | (let ((i (+ (ash (elt s 0) 56) 121 | (ash (elt s 1) 48) 122 | (ash (elt s 2) 40) 123 | (ash (elt s 3) 32) 124 | (ash (elt s 4) 24) 125 | (ash (elt s 5) 16) 126 | (ash (elt s 6) 8) 127 | (elt s 7)))) 128 | i)) 129 | 130 | (defun decode-float64 (s) 131 | (ieee-floats:decode-float64 (decode-uint64 s))) 132 | 133 | (defun sc-decode-timetag (timetag) 134 | (if (equalp timetag *immediate-timetag*) 135 | 1 136 | (decode-uint64 timetag))) 137 | 138 | (defun sc-decode-taged-data (data) 139 | (let ((div (position 0 data))) 140 | (let ((tags (subseq data 1 div)) 141 | (acc (subseq data (osc::padded-length div))) 142 | (result '())) 143 | (map 'vector 144 | #'(lambda (x) 145 | (cond 146 | ((eq x (char-code #\i)) 147 | (push (osc::decode-int32 (subseq acc 0 4)) 148 | result) 149 | (setf acc (subseq acc 4))) 150 | ((eq x (char-code #\f)) 151 | (push (osc::decode-float32 (subseq acc 0 4)) 152 | result) 153 | (setf acc (subseq acc 4))) 154 | ((eq x (char-code #\s)) 155 | (let ((pointer (osc::padded-length (position 0 acc)))) 156 | (push (osc::decode-string 157 | (subseq acc 0 pointer)) 158 | result) 159 | (setf acc (subseq acc pointer)))) 160 | ((eq x (char-code #\b)) 161 | (let* ((size (osc::decode-int32 (subseq acc 0 4))) 162 | (end (osc::padded-length (+ 4 size)))) 163 | (push (osc::decode-blob (subseq acc 0 end)) 164 | result) 165 | (setf acc (subseq acc end)))) 166 | ((eq x (char-code #\d)) 167 | (push (decode-float64 (subseq acc 0 8)) result) 168 | (setf acc (subseq acc 8))) 169 | (t (error "unrecognised typetag ~a(~a)" (code-char x) x)))) 170 | tags) 171 | (nreverse result)))) 172 | 173 | (defun decode-message (message) 174 | (declare (type (vector *) message)) 175 | (let ((x (position (char-code #\,) message))) 176 | (if (eq x NIL) 177 | (format t "message contains no data.. ") 178 | (cons (osc::decode-address (subseq message 0 x)) 179 | (sc-decode-taged-data (subseq message x)))))) 180 | 181 | (defun decode-bundle-iter (data) 182 | (let ((contents '())) 183 | (if (= 35 (elt data 0)) 184 | (let ((timetag (subseq data 8 16)) 185 | (i 16) 186 | (bundle-length (length data))) 187 | (loop while (< i bundle-length) 188 | do (let ((mark (+ i 4)) 189 | (size (osc::decode-int32 190 | (subseq data i (+ i 4))))) 191 | (if (eq size 0) (setf bundle-length 0) 192 | (if (< (+ mark size) usocket:+max-datagram-packet-size+) 193 | (push (decode-bundle-iter 194 | (subseq data mark (+ mark size))) 195 | contents) 196 | ;(error "out of index ~d to ~d over ~d" mark (+ mark size) usocket:+max-datagram-packet-size+) 197 | )) 198 | (incf i (+ 4 size)))) 199 | (push timetag contents)) 200 | (decode-message data)))) 201 | 202 | (defun decode-bundle (data) 203 | (if (= 35 (elt data 0)) (decode-bundle-iter data) 204 | (list *immediate-timetag* (decode-message data)))) 205 | -------------------------------------------------------------------------------- /ugens/Noise.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defugen (rand-seed "RandSeed") (&optional (trig 0.0) (seed 56789)) 4 | ((:ar (progn (multinew new 'width-first-ugen trig seed) 0.0)) 5 | (:kr (progn (multinew new 'width-first-ugen trig seed) 0.0)) 6 | (:ir (progn (multinew new 'width-first-ugen trig seed) 0.0)))) 7 | 8 | (defugen (rand-id "RandID") (&optional (id 0)) 9 | ((:kr (progn (multinew new 'width-first-ugen id) 0.0)) 10 | (:ir (progn (multinew new 'width-first-ugen id) 0.0)))) 11 | 12 | (defugen (rand "Rand") 13 | (&optional (lo 0.0) (hi 1.0)) 14 | ((:ir (multinew new 'ugen lo hi)))) 15 | 16 | (defugen (i-rand "IRand") 17 | (&optional (lo 0) (hi 127)) 18 | ((:ir (multinew new 'ugen lo hi)))) 19 | 20 | (defugen (t-rand "TRand") 21 | (&optional (lo 0.0) (hi 1.0) (trig 0.0)) 22 | ((:ar (multinew new 'ugen lo hi trig)) 23 | (:kr (multinew new 'ugen lo hi trig)))) 24 | 25 | (defugen (ti-rand "TIRand") 26 | (&optional (lo 0.0) (hi 127) (trig 0.0)) 27 | ((:kr (multinew new 'ugen lo hi trig)) 28 | (:ar (multinew new 'ugen lo hi trig)))) 29 | 30 | (defugen (lin-rand "LinRand") 31 | (&optional (lo 0.0) (hi 1.0) (minmax 0.0)) 32 | ((:ir (multinew new 'ugen lo hi minmax)))) 33 | 34 | (defugen (n-rand "NRand") 35 | (&optional (lo 0.0) (hi 1.0) (n 0.0)) 36 | ((:ir (multinew new 'ugen lo hi n)))) 37 | 38 | (defugen (exp-rand "ExpRand") 39 | (&optional (lo 0.01) (hi 1.0)) 40 | ((:ir (multinew new 'ugen lo hi)))) 41 | 42 | (defugen (t-exp-rand "TExpRand") 43 | (&optional (lo 0.01) (hi 1.0) (trig 0.0)) 44 | ((:ar (multinew new 'ugen lo hi trig)) 45 | (:kr (multinew new 'ugen lo hi trig)))) 46 | 47 | (defugen (coin-gate "CoinGate") 48 | (prob in) 49 | ((:ar (multinew new 'ugen prob in)) 50 | (:kr (multinew new 'ugen prob in)))) 51 | 52 | (defugen (tw-index "TWindex") 53 | (in array &optional (normalize 0.0)) 54 | ((:ar (apply 'multinew new 'ugen (cons in (cons normalize array)))) 55 | (:kr (apply 'multinew new 'ugen (cons in (cons normalize array)))))) 56 | 57 | (defugen (white-noise "WhiteNoise") 58 | (&optional (mul 1.0) (add 0.0)) 59 | ((:ar 60 | (if (listp mul) (madd 61 | (dup (lambda (i) (declare (ignore i)) (multinew new 'ugen)) (length mul)) mul add) 62 | (madd (multinew new 'ugen) mul add))) 63 | (:kr 64 | (if (listp mul) (madd (dup (lambda (i) (declare (ignore i)) (multinew new 'ugen)) (length mul)) mul add) 65 | (madd (multinew new 'ugen) mul add))))) 66 | 67 | (defugen (brown-noise "BrownNoise") 68 | (&optional (mul 1.0) (add 0.0)) 69 | ((:ar 70 | (if (listp mul) (madd (dup (lambda (i) (declare (ignore i)) (multinew new 'ugen)) (length mul)) mul add) 71 | (madd (multinew new 'ugen) mul add))) 72 | (:kr 73 | (if (listp mul) (madd (dup (lambda (i) (declare (ignore i)) (multinew new 'ugen)) (length mul)) mul add) 74 | (madd (multinew new 'ugen) mul add))))) 75 | 76 | (defugen (pink-noise "PinkNoise") 77 | (&optional (mul 1.0) (add 0.0)) 78 | ((:ar 79 | (if (listp mul) (madd (dup (lambda (i) (declare (ignore i)) (multinew new 'ugen)) (length mul)) mul add) 80 | (madd (multinew new 'ugen) mul add))) 81 | (:kr 82 | (if (listp mul) (madd (dup (lambda (i) (declare (ignore i)) (multinew new 'ugen)) (length mul)) mul add) 83 | (madd (multinew new 'ugen) mul add))))) 84 | 85 | (defugen (clip-noise "ClipNoise") 86 | (&optional (mul 1.0) (add 0.0)) 87 | ((:ar 88 | (if (listp mul) (madd (dup (lambda (i) (declare (ignore i)) (multinew new 'ugen)) (length mul)) mul add) 89 | (madd (multinew new 'ugen) mul add))) 90 | (:kr 91 | (if (listp mul) (madd (dup (lambda (i) (declare (ignore i)) (multinew new 'ugen)) (length mul)) mul add) 92 | (madd (multinew new 'ugen) mul add))))) 93 | 94 | (defugen (gray-noise "GrayNoise") 95 | (&optional (mul 1.0) (add 0.0)) 96 | ((:ar 97 | (if (listp mul) (madd (dup (lambda (i) (declare (ignore i)) (multinew new 'ugen)) (length mul)) mul add) 98 | (madd (multinew new 'ugen) mul add))) 99 | (:kr 100 | (if (listp mul) (madd (dup (lambda (i) (declare (ignore i)) (multinew new 'ugen)) (length mul)) mul add) 101 | (madd (multinew new 'ugen) mul add))))) 102 | 103 | (defugen (crackle "Crackle") 104 | (&optional (chaos-param 1.5) (mul 1.0) (add 0.0)) 105 | ((:ar 106 | (madd (multinew new 'ugen chaos-param) mul add)) 107 | (:kr 108 | (madd (multinew new 'ugen chaos-param) mul add)))) 109 | 110 | (defugen (logistic "Logistic") 111 | (&optional (chaos-param 3.0) (freq 1000.0) (init 0.5) (mul 1.0) (add 0.0)) 112 | ((:ar 113 | (madd (multinew new 'ugen chaos-param freq init) mul add)) 114 | (:kr 115 | (madd (multinew new 'ugen chaos-param freq init) mul add)))) 116 | 117 | (defugen (lf-noise0 "LFNoise0") 118 | (&optional (freq 500.0) (mul 1.0) (add 0.0)) 119 | ((:ar (madd (multinew new 'ugen freq) mul add)) 120 | (:kr (madd (multinew new 'ugen freq) mul add)))) 121 | 122 | (defugen (lf-noise1 "LFNoise1") 123 | (&optional (freq 500.0) (mul 1.0) (add 0.0)) 124 | ((:ar (madd (multinew new 'ugen freq) mul add)) 125 | (:kr (madd (multinew new 'ugen freq) mul add)))) 126 | 127 | (defugen (lf-noise2 "LFNoise2") 128 | (&optional (freq 500.0) (mul 1.0) (add 0.0)) 129 | ((:ar (madd (multinew new 'ugen freq) mul add)) 130 | (:kr (madd (multinew new 'ugen freq) mul add)))) 131 | 132 | (defugen (lf-clip-noise "LFClipNoise") 133 | (&optional (freq 500.0) (mul 1.0) (add 0.0)) 134 | ((:ar (madd (multinew new 'ugen freq) mul add)) 135 | (:kr (madd (multinew new 'ugen freq) mul add)))) 136 | 137 | (defugen (lfd-noise0 "LFDNoise0") 138 | (&optional (freq 500.0) (mul 1.0) (add 0.0)) 139 | ((:ar (madd (multinew new 'ugen freq) mul add)) 140 | (:kr (madd (multinew new 'ugen freq) mul add)))) 141 | 142 | (defugen (lfd-noise1 "LFDNoise1") 143 | (&optional (freq 500.0) (mul 1.0) (add 0.0)) 144 | ((:ar (madd (multinew new 'ugen freq) mul add)) 145 | (:kr (madd (multinew new 'ugen freq) mul add)))) 146 | 147 | (defugen (lfd-noise3 "LFDNoise3") 148 | (&optional (freq 500.0) (mul 1.0) (add 0.0)) 149 | ((:ar (madd (multinew new 'ugen freq) mul add)) 150 | (:kr (madd (multinew new 'ugen freq) mul add)))) 151 | 152 | (defugen (lfd-clip-noise "LFDClipNoise") 153 | (&optional (freq 500.0) (mul 1.0) (add 0.0)) 154 | ((:ar (madd (multinew new 'ugen freq) mul add)) 155 | (:kr (madd (multinew new 'ugen freq) mul add)))) 156 | 157 | (defugen (hasher "Hasher") 158 | (&optional (in 0.0) (mul 1.0) (add 0.0)) 159 | ((:ar (madd (multinew new 'ugen in) mul add)) 160 | (:kr (madd (multinew new 'ugen in) mul add)))) 161 | 162 | (defugen (mantissa-mask "MantissaMask") 163 | (&optional (in 0.0) (bits 3.0) (mul 1.0) (add 0.0)) 164 | ((:ar (madd (multinew new 'ugen in bits) mul add)) 165 | (:kr (madd (multinew new 'ugen in bits) mul add)))) 166 | 167 | (defugen (dust "Dust") (&optional (density 0.0) (mul 1.0) (add 0.0)) 168 | ((:ar (madd (multinew new 'ugen density) mul add)) 169 | (:kr (madd (multinew new 'ugen density) mul add))) 170 | :signal-range :unipolar) 171 | 172 | (defugen (dust2 "Dust2") 173 | (&optional (density 0.0) (mul 1.0) (add 0.0)) 174 | ((:ar (madd (multinew new 'ugen density) mul add)) 175 | (:kr (madd (multinew new 'ugen density) mul add)))) 176 | -------------------------------------------------------------------------------- /ugens/SC3plugins/BhobUGens.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defugen (nested-allpass-n "NestedAllpassN") 4 | (in &optional (maxdelay1 0.036) (delay1 0.036) (gain1 0.08) (maxdelay2 0.03) (delay2 0.03) (gain2 0.3) (mul 1.0) (add 0.0)) 5 | ((:ar 6 | (madd (multinew new 'ugen in maxdelay1 delay1 gain1 maxdelay2 delay2 gain2) mul add)))) 7 | 8 | (defugen (nested-allpass-l "NestedAllpassL") 9 | (in &optional (maxdelay1 0.036) (delay1 0.036) (gain1 0.08) (maxdelay2 0.03) (delay2 0.03) (gain2 0.3) (mul 1.0) (add 0.0)) 10 | ((:ar 11 | (madd (multinew new 'ugen in maxdelay1 delay1 gain1 maxdelay2 delay2 gain2) mul add)))) 12 | 13 | (defugen (nested-allpass-c "NestedAllpassC") 14 | (in &optional (maxdelay1 0.036) (delay1 0.036) (gain1 0.08) (maxdelay2 0.03) (delay2 0.03) (gain2 0.3) (mul 1.0) (add 0.0)) 15 | ((:ar 16 | (madd (multinew new 'ugen in maxdelay1 delay1 gain1 maxdelay2 delay2 gain2) mul add)))) 17 | 18 | (defugen (double-nested-allpass-n "DoubleNestedAllpassN") 19 | (in &optional (maxdelay1 0.0047) (delay1 0.0047) (gain1 0.15) (maxdelay2 0.022) (delay2 0.022) (gain2 0.25) 20 | (maxdelay3 0.0083) (delay3 0.0083) (gain3 0.3) (mul 1.0) (add 0.0)) 21 | ((:ar 22 | (madd (multinew new 'ugen in maxdelay1 delay1 gain1 maxdelay2 delay2 gain2 maxdelay3 delay3 gain3) mul add)))) 23 | 24 | (defugen (double-nested-allpass-l "DoubleNestedAllpassL") 25 | (in &optional (maxdelay1 0.0047) (delay1 0.0047) (gain1 0.15) (maxdelay2 0.022) (delay2 0.022) (gain2 0.25) 26 | (maxdelay3 0.0083) (delay3 0.0083) (gain3 0.3) (mul 1.0) (add 0.0)) 27 | ((:ar 28 | (madd (multinew new 'ugen in maxdelay1 delay1 gain1 maxdelay2 delay2 gain2 maxdelay3 delay3 gain3) mul add)))) 29 | 30 | (defugen (double-nested-allpass-c "DoubleNestedAllpassC") 31 | (in &optional (maxdelay1 0.0047) (delay1 0.0047) (gain1 0.15) (maxdelay2 0.022) (delay2 0.022) (gain2 0.25) 32 | (maxdelay3 0.0083) (delay3 0.0083) (gain3 0.3) (mul 1.0) (add 0.0)) 33 | ((:ar 34 | (madd (multinew new 'ugen in maxdelay1 delay1 gain1 maxdelay2 delay2 gain2 maxdelay3 delay3 gain3) mul add)))) 35 | 36 | 37 | (defugen (moog-ladder "MoogLadder") 38 | (in &optional (ffreq 440.0) (res 0.0) (mul 1.0) (add 0.0)) 39 | ((:ar 40 | (madd (multinew new 'ugen in ffreq res) mul add)) 41 | (:kr 42 | (madd (multinew new 'ugen in ffreq res) mul add)))) 43 | 44 | 45 | (defugen (rlpfd "RLPFD") 46 | (in &optional (ffreq 440.0) (res 0.0) (dist 0.0) (mul 1.0) (add 0.0)) 47 | ((:ar 48 | (madd (multinew new 'ugen in ffreq res dist) mul add)) 49 | (:kr 50 | (madd (multinew new 'ugen in ffreq res dist) mul add)))) 51 | 52 | (defugen (streson "Streson") 53 | (input &optional (delay-time 0.003) (res 0.9) (mul 1.0) (add 0.0)) 54 | ((:ar 55 | (madd (multinew new 'ugen input delay-time res) mul add)) 56 | (:kr 57 | (madd (multinew new 'ugen input delay-time res) mul add)))) 58 | 59 | (defugen (nlfilt-n "NLFiltN") 60 | (input a b d c l &optional (mul 1.0) (add 0.0)) 61 | ((:ar 62 | (madd (multinew new 'ugen input a b d c l) mul add)) 63 | (:kr 64 | (madd (multinew new 'ugen input a b d c l) mul add)))) 65 | 66 | (defugen (nlfilt-l "NLFiltL") 67 | (input a b d c l &optional (mul 1.0) (add 0.0)) 68 | ((:ar 69 | (madd (multinew new 'ugen input a b d c l) mul add)) 70 | (:kr 71 | (madd (multinew new 'ugen input a b d c l) mul add)))) 72 | 73 | (defugen (nlfilt-c "NLFiltC") 74 | (input a b d c l &optional (mul 1.0) (add 0.0)) 75 | ((:ar 76 | (madd (multinew new 'ugen input a b d c l) mul add)) 77 | (:kr 78 | (madd (multinew new 'ugen input a b d c l) mul add)))) 79 | 80 | (defugen (gauss-trig "GaussTrig") 81 | (&optional (freq 440.0) (dev 0.3) (mul 1.0) (add 0.0)) 82 | ((:ar 83 | (madd (multinew new 'ugen freq dev) mul add)) 84 | (:kr 85 | (madd (multinew new 'ugen freq dev) mul add))) 86 | :signal-range :unipolar) 87 | 88 | (defugen (lf-brown-noise0 "LFBrownNoise0") 89 | (&optional (freq 20) (dev 1.0) (dist 0.0) (mul 1.0) (add 0.0)) 90 | ((:ar 91 | (madd (multinew new 'ugen freq dev dist) mul add)) 92 | (:kr 93 | (madd (multinew new 'ugen freq dev dist) mul add)))) 94 | 95 | (defugen (lf-brown-noise1 "LFBrownNoise1") 96 | (&optional (freq 20) (dev 1.0) (dist 0.0) (mul 1.0) (add 0.0)) 97 | ((:ar 98 | (madd (multinew new 'ugen freq dev dist) mul add)) 99 | (:kr 100 | (madd (multinew new 'ugen freq dev dist) mul add)))) 101 | 102 | (defugen (lf-brown-noise2 "LFBrownNoise2") 103 | (&optional (freq 20) (dev 1.0) (dist 0.0) (mul 1.0) (add 0.0)) 104 | ((:ar 105 | (madd (multinew new 'ugen freq dev dist) mul add)) 106 | (:kr 107 | (madd (multinew new 'ugen freq dev dist) mul add)))) 108 | 109 | (defugen (t-brown-rand "TBrownRand") 110 | (&optional (lo 0.0) (hi 1.0) (dev 1.0) (dist 0.0) (trig 0.0) (mul 1.0) (add 0.0)) 111 | ((:ar 112 | (madd (multinew new 'ugen lo hi dev dist trig) mul add)) 113 | (:kr 114 | (madd (multinew new 'ugen lo hi dev dist trig) mul add)))) 115 | 116 | (def-dugen (d-brown2 "Dbrown2") (lo hi step dist &optional (length +inf+)) 117 | (multinew new 'dugen length lo hi step dist)) 118 | 119 | (def-dugen (d-gauss "Dgauss") (lo hi &optional (length +inf+)) 120 | (multinew new 'dugen length lo hi)) 121 | 122 | (defugen (t-gauss-rand "TGaussRand") 123 | (&optional (lo 0.0) (hi 1.0) (trig 0.0) (mul 1.0) (add 0.0)) 124 | ((:ar 125 | (madd (multinew new 'ugen lo hi trig) mul add)) 126 | (:kr 127 | (madd (multinew new 'ugen lo hi trig) mul add)))) 128 | 129 | (defugen (t-beta-rand "TBetaRand") 130 | (&optional (lo 0.0) (hi 1.0) (prob1 0.0) (prob2 0.0) (trig 0.0) (mul 1.0) (add 0.0)) 131 | ((:ar 132 | (madd (multinew new 'ugen lo hi prob1 prob2 trig) mul add)) 133 | (:kr 134 | (madd (multinew new 'ugen lo hi prob1 prob2 trig) mul add)))) 135 | 136 | 137 | (defugen (gendy4 "Gendy4") 138 | (&optional (amp-dist 1) (dur-dist 1) (ad-param 1.0) (dd-param 1.0) 139 | (min-freq 440.0) (max-freq 660.0) (amp-scale 0.5) (dur-scale 0.5) 140 | (init-cps 12) knum (mul 1.0) (add 1.0)) 141 | ((:ar (madd (multinew new 'ugen amp-dist dur-dist ad-param dd-param min-freq 142 | max-freq amp-scale dur-scale init-cps (if knum knum init-cps)) 143 | mul add)) 144 | (:kr (madd (multinew new 'ugen amp-dist dur-dist ad-param dd-param min-freq 145 | max-freq amp-scale dur-scale init-cps (if knum knum init-cps)) 146 | mul add)))) 147 | 148 | (defugen (gendy5 "Gendy5") 149 | (&optional (amp-dist 1) (dur-dist 1) (ad-param 1.0) (dd-param 1.0) 150 | (min-freq 440.0) (max-freq 660.0) (amp-scale 0.5) (dur-scale 0.5) 151 | (init-cps 12) knum (mul 1.0) (add 1.0)) 152 | ((:ar (madd (multinew new 'ugen amp-dist dur-dist ad-param dd-param min-freq 153 | max-freq amp-scale dur-scale init-cps (if knum knum init-cps)) 154 | mul add)) 155 | (:kr (madd (multinew new 'ugen amp-dist dur-dist ad-param dd-param min-freq 156 | max-freq amp-scale dur-scale init-cps (if knum knum init-cps)) 157 | mul add)))) 158 | 159 | (defugen (tgrains2 "TGrains2") 160 | (chanls &optional (trigger 0) (bufnum 0) (rate 1) (center-pos 0) 161 | (dur .1) (pan 0) (amp .1) (attk .5) (dec .5) (interp 4)) 162 | ((:ar (progn (when (< chanls 2) (error "TGrains needs at least two channels.")) 163 | (multinew new 'multiout-ugen chanls trigger bufnum rate center-pos dur pan amp 164 | attk dec interp))))) 165 | 166 | (defugen (tgrains3 "TGrains3") 167 | (chanls &optional (trigger 0) (bufnum 0) (rate 1) (center-pos 0) 168 | (dur .1) (pan 0.0) (amp .1) (attk .5) (dec .5) (window 1) (interp 4)) 169 | ((:ar (progn (when (< chanls 2) (error "TGrains needs at least two channels.")) 170 | (multinew new 'multiout-ugen chanls trigger bufnum rate center-pos dur pan amp 171 | attk dec window interp))))) 172 | -------------------------------------------------------------------------------- /ugens/FFT.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defmacro def-pv-chain-ugen (name args &body body) 4 | `(progn (defun ,(car name) ,args 5 | (let ((new (lambda (cls &rest inputs) (apply #'ugen-new ,(second name) :control cls #'identity :bipolar 6 | inputs)))) 7 | ,@body)) 8 | (export ',(car name) :sc))) 9 | 10 | 11 | (defun fft (buffer &optional (in 0.0) (hop 0.5) (wintype 0) (active 1) 12 | (winsize 0)) 13 | (multinew (lambda (cls &rest inputs) (apply #'ugen-new "FFT" :control cls #'identity :bipolar inputs)) 14 | 'pv-chain-ugen buffer in hop wintype active winsize)) 15 | 16 | (defugen (ifft "IFFT") 17 | (buffer &optional (wintype 0) (winsize 0)) 18 | ((:ar 19 | (multinew new 'width-first-ugen buffer wintype winsize)) 20 | (:kr 21 | (multinew new 'width-first-ugen buffer wintype winsize)))) 22 | 23 | (def-pv-chain-ugen (pv-mag-above "PV_MagAbove") (buffer &optional (threshold 0.0)) 24 | (multinew new 'pv-chain-ugen buffer threshold)) 25 | 26 | (def-pv-chain-ugen (pv-mag-below "PV_MagBelow") (buffer &optional (threshold 0.0)) 27 | (multinew new 'pv-chain-ugen buffer threshold)) 28 | 29 | (def-pv-chain-ugen (pv-mag-clip "PV_MagClip") 30 | (buffer &optional (threshold 0.0)) 31 | (multinew new 'pv-chain-ugen buffer threshold)) 32 | 33 | (def-pv-chain-ugen (pv-local-max "PV_LocalMax") 34 | (buffer &optional (threshold 0.0)) 35 | (multinew new 'pv-chain-ugen buffer threshold)) 36 | 37 | 38 | (def-pv-chain-ugen (pv-mag-smear "PV_MagSmear") 39 | (buffer &optional (bins 0.0)) 40 | (multinew new 'pv-chain-ugen buffer bins)) 41 | 42 | (def-pv-chain-ugen (pv-bin-shift "PV_BinShift") 43 | (buffer &optional (stretch 1.0) (shift 0.0) (interp 0.0)) 44 | (multinew new 'pv-chain-ugen buffer stretch shift interp)) 45 | 46 | (def-pv-chain-ugen (pv-mag-shift "PV_MagShift") 47 | (buffer &optional (stretch 1.0) (shift 0.0)) 48 | (multinew new 'pv-chain-ugen buffer stretch shift)) 49 | 50 | (def-pv-chain-ugen (pv-mag-squared "PV_MagSquared") 51 | (buffer) 52 | (multinew new 'pv-chain-ugen buffer)) 53 | 54 | (def-pv-chain-ugen (pv-mag-noise "PV_MagNoise") 55 | (buffer) 56 | (multinew new 'pv-chain-ugen buffer)) 57 | 58 | (def-pv-chain-ugen (pv-phase-shift90 "PV_PhaseShift90") 59 | (buffer) 60 | (multinew new 'pv-chain-ugen buffer)) 61 | 62 | (def-pv-chain-ugen (pv-phase-shift270 "PV_PhaseShift270") 63 | (buffer) 64 | (multinew new 'pv-chain-ugen buffer)) 65 | 66 | (def-pv-chain-ugen (pv-conj "PV_Conj") 67 | (buffer) 68 | (multinew new 'pv-chain-ugen buffer)) 69 | 70 | (def-pv-chain-ugen (pv-phase-shift "PV_PhaseShift") 71 | (buffer shift) 72 | (multinew new 'pv-chain-ugen buffer shift)) 73 | 74 | (def-pv-chain-ugen (pv-brick-wall "PV_BrickWall") 75 | (buffer &optional (wipe 0.0)) 76 | (multinew new 'pv-chain-ugen buffer wipe)) 77 | 78 | (def-pv-chain-ugen (pv-bin-wipe "PV_BinWipe") 79 | (buffer-a buffer-b &optional (wipe 0.0)) 80 | (multinew new 'pv-chain-ugen buffer-a buffer-b wipe)) 81 | 82 | (def-pv-chain-ugen (pv-mag-mul "PV_MagMul") 83 | (buffer-a buffer-b) 84 | (multinew new 'pv-chain-ugen buffer-a buffer-b)) 85 | 86 | (def-pv-chain-ugen (pv-copy-phase "PV_CopyPhase") 87 | (buffer-a buffer-b) 88 | (multinew new 'pv-chain-ugen buffer-a buffer-b)) 89 | 90 | (def-pv-chain-ugen (pv-copy "PV_Copy") 91 | (buffer-a buffer-b) 92 | (multinew new 'pv-chain-ugen buffer-a buffer-b)) 93 | 94 | (def-pv-chain-ugen (pv-max "PV_Max") 95 | (buffer-a buffer-b) 96 | (multinew new 'pv-chain-ugen buffer-a buffer-b)) 97 | 98 | (def-pv-chain-ugen (pv-min "PV_Min") 99 | (buffer-a buffer-b) 100 | (multinew new 'pv-chain-ugen buffer-a buffer-b)) 101 | 102 | (def-pv-chain-ugen (pv-mul "PV_Mul") 103 | (buffer-a buffer-b) 104 | (multinew new 'pv-chain-ugen buffer-a buffer-b)) 105 | 106 | (def-pv-chain-ugen (pv-div "PV_Div") 107 | (buffer-a buffer-b) 108 | (multinew new 'pv-chain-ugen buffer-a buffer-b)) 109 | 110 | (def-pv-chain-ugen (pv-add "PV_Add") 111 | (buffer-a buffer-b) 112 | (multinew new 'pv-chain-ugen buffer-a buffer-b)) 113 | 114 | (def-pv-chain-ugen (pv-mag-div "PV_MagDiv") 115 | (buffer-a buffer-b &optional (zeroed 0.0001)) 116 | (multinew new 'pv-chain-ugen buffer-a buffer-b zeroed)) 117 | 118 | (def-pv-chain-ugen (pv-rand-comb "PV_RandComb") 119 | (buffer &optional (wipe 0.0) (trig 0.0)) 120 | (multinew new 'pv-chain-ugen buffer wipe trig)) 121 | 122 | (def-pv-chain-ugen (pv-rect-comb "PV_RectComb") 123 | (buffer &optional (num-teeth 0.0) (phase 0.0) (width 0.5)) 124 | (multinew new 'pv-chain-ugen buffer num-teeth phase width)) 125 | 126 | (def-pv-chain-ugen (pv-rect-comb2 "PV_RectComb2") 127 | (buffer-a buffer-b &optional (num-teeth 0.0) (phase 0.0) (width 0.5)) 128 | (multinew new 'pv-chain-ugen buffer-a buffer-b num-teeth phase width)) 129 | 130 | (def-pv-chain-ugen (pv-rand-wipe "PV_RandWipe") 131 | (buffer-a buffer-b &optional (wipe 0.0) (trig 0.0)) 132 | (multinew new 'pv-chain-ugen buffer-a buffer-b wipe trig)) 133 | 134 | (def-pv-chain-ugen (pv-diffuser "PV_Diffuser") 135 | (buffer &optional (trig 0.0)) 136 | (multinew new 'pv-chain-ugen buffer trig)) 137 | 138 | (def-pv-chain-ugen (pv-mag-freeze "PV_MagFreeze") 139 | (buffer &optional (freeze 0.0)) 140 | (multinew new 'pv-chain-ugen buffer freeze)) 141 | 142 | (def-pv-chain-ugen (pv-bin-scramble "PV_BinScramble") 143 | (buffer &optional (wipe 0.0) (width 0.2) (trig 0.0)) 144 | (multinew new 'pv-chain-ugen buffer wipe width trig)) 145 | 146 | (def-pv-chain-ugen (fft-trigger "FFTTrigger") 147 | (buffer &optional (hop 0.5) (polar 0.0)) 148 | (multinew new 'pv-chain-ugen buffer hop polar)) 149 | 150 | (def-pv-chain-ugen (pv-conformal-map "PV_ConformalMap") 151 | (buffer &optional (areal 0.0) (aimag 0.0)) 152 | (multinew new 'pv-chain-ugen buffer areal aimag)) 153 | 154 | 155 | 156 | (defugen (convolution "Convolution") 157 | (in kernel &optional (framesize 512) (mul 1.0) (add 0.0)) 158 | ((:ar 159 | (madd (multinew new 'ugen in kernel framesize) mul add)))) 160 | 161 | (defugen (convolution2 "Convolution2") 162 | (in kernel &optional (trigger 0) (framesize 2048) (mul 1.0) (add 0.0)) 163 | ((:ar 164 | (madd (multinew new 'ugen in kernel trigger framesize) mul add)))) 165 | 166 | (defugen (convolution2-l "Convolution2L") 167 | (in kernel &optional (trigger 0) (framesize 2048) (crossfade 1) (mul 1.0) (add 0.0)) 168 | ((:ar 169 | (madd (multinew new 'ugen in kernel trigger framesize crossfade) mul add)))) 170 | 171 | 172 | 173 | (defugen (stereo-convolution2-l "StereoConvolution2L") 174 | (in kernel-l kernel-r &optional (trigger 0) (framesize 2048) (crossfade 1) (mul 1.0) (add 0.0)) 175 | ((:ar 176 | (madd (multinew new 'multiout-ugen 2 in kernel-l kernel-r trigger framesize crossfade) mul add)))) 177 | 178 | (defugen (convolution3 "Convolution3") 179 | (in kernel &optional (trigger 0) (framesize 2048) (mul 1.0) (add 0.0)) 180 | ((:ar 181 | (madd (multinew new 'ugen in kernel trigger framesize) mul add)) 182 | (:kr 183 | (madd (multinew new 'ugen in kernel trigger framesize) mul add)))) 184 | 185 | (defugen (pv-jensen-andersen "PV_JensenAndersen") 186 | (buffer &optional (propsc .25) (prophfe .25) (prophfc .25) (propsf .25) 187 | (threshold 1.0) (waittime .04)) 188 | ((:ar 189 | (multinew new 'pv-chain-ugen buffer propsc prophfe prophfc propsf threshold waittime)))) 190 | 191 | (defugen (pv-hainsworth-foote "PV_HainsworthFoote") 192 | (buffer &optional (proph 0.0) (propf 0.0) (threshold 1.0) (waittime 0.04)) 193 | ((:ar 194 | (multinew new 'pv-chain-ugen buffer proph propf threshold waittime)))) 195 | 196 | 197 | (defugen (running-sum "RunningSum") 198 | (in &optional (num-samp 40.0)) 199 | ((:ar (multinew new 'ugen in num-samp)) 200 | (:kr (multinew new 'ugen in num-samp)))) 201 | 202 | (defun running-sum-rms (in &optional (num-samp 40.0)) 203 | (sqrt~ 204 | (mul (running-sum.ar (squared in) num-samp) 205 | (reciprocal num-samp)))) 206 | -------------------------------------------------------------------------------- /ugens/quarks/miSCellaneous_lib/WaveFolding.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defun smooth-clip-s-gen (rate in lo hi amount delta) 4 | (let* ((dc-ugen (if (eql rate :control) #'dc.kr #'dc.ar)) 5 | (dif (-~ hi lo)) 6 | (sum (+~ hi lo)) 7 | (dif (*~ (max~ (abs~ dif) delta) 8 | (-~ (*~ (>=~ dif (funcall dc-ugen 0)) 2) 1))) 9 | (from-factor (/~ 2 dif)) 10 | (from-offset (+~ (*~ from-factor (neg hi)) 1)) 11 | (in (+~ (*~ from-factor in) from-offset)) 12 | (x0 (min~ (-~ 1.0 amount) (-~ 1.0 delta))) 13 | (w (*~ x0 pi 0.5)) 14 | (p (/~ 1.0 (+~ (-~ 1.0 (sin~ w)) (*~ w (cos~ w))))) 15 | (slope (*~ p pi 0.5 (cos~ w))) 16 | (lin-sig (*~ slope in)) 17 | (sine-sig (*~ (+~ (*~ (-~ (sin~ (*~ (abs~ in) pi 0.5)) 1.0) p) 1.0) (sign in))) 18 | (case-var (+~ (>~ (abs~ in) x0) (>=~ (abs~ in) 1) (<=~ in -1))) 19 | (select-ugen (if (eql rate :control) #'select.kr #'select.ar))) 20 | (funcall select-ugen case-var 21 | (*~ 22 | (+~ 23 | (*~ (list lin-sig sine-sig (funcall dc-ugen 1.0) (funcall dc-ugen -1.0)) 24 | dif) 25 | sum) 26 | 0.5)))) 27 | 28 | (defun smooth-clip-s.ar (in &optional (lo -1.0) (hi 1.0) (amount 0.5) (delta 0.00001)) 29 | (multinew #'smooth-clip-s-gen :audio in lo hi amount delta)) 30 | 31 | (defun smooth-clip-s.kr (in &optional (lo -1.0) (hi 1.0) (amount 0.5) (delta 0.00001)) 32 | (multinew #'smooth-clip-s-gen :control in lo hi amount delta)) 33 | 34 | (defun smooth-clip-q-gen (rate in lo hi amount delta) 35 | (let* ((dc-ugen (if (eql rate :control) #'dc.kr #'dc.ar)) 36 | (dif (-~ hi lo)) 37 | (sum (+~ hi lo)) 38 | (dif (*~ (max~ (abs~ dif) delta) 39 | (-~ (*~ (>=~ dif (funcall dc-ugen 0)) 2) 1))) 40 | (from-factor (/~ 2 dif)) 41 | (from-offset (+~ (*~ from-factor (neg hi)) 1)) 42 | (in (+~ (*~ from-factor in) from-offset)) 43 | (x0 (min~ (-~ 1.0 amount) (-~ 1.0 delta))) 44 | (p (/~ 1.0 (-~ (*~ x0 x0) 1.0))) 45 | (slope (*~ 2.0 p (-~ x0 1.0))) 46 | (lin-sig (*~ slope in)) 47 | (parable-sig (*~ (+~ (*~ (squared (-~ (abs~ in) 1.0)) p) 1.0) (sign in))) 48 | (case-var (+~ (>~ (abs~ in) x0) (>=~ (abs~ in) 1.0) (<=~ in -1))) 49 | (select-ugen (if (eql rate :control) #'select.kr #'select.ar))) 50 | (funcall select-ugen case-var 51 | (*~ 52 | (+~ 53 | (*~ 54 | (list lin-sig parable-sig (funcall dc-ugen 1.0) (funcall dc-ugen -1.0)) 55 | dif) 56 | sum) 57 | 0.5)))) 58 | 59 | (defun smooth-clip-q.ar (in &optional (lo -1.0) (hi 1.0) (amount 0.5) (delta 0.00001)) 60 | (multinew #'smooth-clip-q-gen :audio in lo hi amount delta)) 61 | 62 | (defun smooth-clip-q.kr (in &optional (lo -1.0) (hi 1.0) (amount 0.5) (delta 0.00001)) 63 | (multinew #'smooth-clip-q-gen :control in lo hi amount delta)) 64 | 65 | 66 | (defun smooth-fold-s-gen (rate in lo hi fold-range smooth-amount delta) 67 | (let* ((fold-ugen (if (eql rate :control) #'fold.kr #'fold.ar)) 68 | (case-var (+~ (<~ in lo) (*~ (>~ in hi) 2.0))) 69 | (fold-range-abs (*~ (-~ hi lo) fold-range)) 70 | (thr-1 (+~ lo fold-range-abs)) 71 | (thr-2 (-~ hi fold-range-abs)) 72 | (select-ugen (if (eql rate :control) #'select.kr #'select.ar)) 73 | (smooth-clip-ugen (if (eql rate :control) #'smooth-clip-s.kr #'smooth-clip-s.ar))) 74 | (funcall select-ugen case-var 75 | (list (funcall smooth-clip-ugen in lo hi smooth-amount delta) 76 | (funcall smooth-clip-ugen (funcall fold-ugen in lo thr-1) lo thr-1 smooth-amount delta) 77 | (funcall smooth-clip-ugen (funcall fold-ugen in thr-2 hi) thr-2 hi smooth-amount delta))))) 78 | 79 | (defun smooth-fold-s.ar (in &optional (lo -1.0) (hi 1.0) (fold-range 1.0) (smooth-amount 0.5) (delta 0.00001)) 80 | (multinew #'smooth-fold-s-gen :audio in lo hi fold-range smooth-amount delta)) 81 | 82 | (defun smooth-fold-s.kr (in &optional (lo -1.0) (hi 1.0) (fold-range 1.0) (smooth-amount 0.5) (delta 0.00001)) 83 | (multinew #'smooth-fold-s-gen :control in lo hi fold-range smooth-amount delta)) 84 | 85 | (defun smooth-fold-s2-gen (rate in lo hi fold-range-lo fold-range-hi smooth-amount delta) 86 | (let* ((fold-ugen (if (eql rate :control) #'fold.kr #'fold.ar)) 87 | (case-var (+~ (<~ in lo) (*~ (>~ in hi) 2.0))) 88 | (range-abs (-~ hi lo)) 89 | (thr-1 (+~ lo (*~ range-abs fold-range-lo))) 90 | (thr-2 (-~ hi (*~ range-abs fold-range-hi))) 91 | (select-ugen (if (eql rate :control) #'select.kr #'select.ar)) 92 | (smooth-clip-ugen (if (eql rate :control) #'smooth-clip-s.kr #'smooth-clip-s.ar))) 93 | (funcall select-ugen case-var 94 | (list (funcall smooth-clip-ugen in lo hi smooth-amount delta) 95 | (funcall smooth-clip-ugen (funcall fold-ugen in lo thr-1) lo thr-1 smooth-amount delta) 96 | (funcall smooth-clip-ugen (funcall fold-ugen in thr-2 hi) thr-2 hi smooth-amount delta))))) 97 | 98 | (defun smooth-fold-s2.ar (in &optional (lo -1.0) (hi 1.0) (fold-range-lo 1.0) (fold-range-hi 1.0) (smooth-amount 0.5) (delta 0.00001)) 99 | (multinew #'smooth-fold-s2-gen :audio in lo hi fold-range-lo fold-range-hi smooth-amount delta)) 100 | 101 | (defun smooth-fold-s2.kr (in &optional (lo -1.0) (hi 1.0) (fold-range-lo 1.0) (fold-range-hi 1.0) (smooth-amount 0.5) (delta 0.00001)) 102 | (multinew #'smooth-fold-s2-gen :control in lo hi fold-range-lo fold-range-hi smooth-amount delta)) 103 | 104 | 105 | (defun smooth-fold-q-gen (rate in lo hi fold-range smooth-amount delta) 106 | (let* ((fold-ugen (if (eql rate :control) #'fold.kr #'fold.ar)) 107 | (case-var (+~ (<~ in lo) (*~ (>~ in hi) 2.0))) 108 | (fold-range-abs (*~ (-~ hi lo) fold-range)) 109 | (thr-1 (+~ lo fold-range-abs)) 110 | (thr-2 (-~ hi fold-range-abs)) 111 | (select-ugen (if (eql rate :control) #'select.kr #'select.ar)) 112 | (smooth-clip-ugen (if (eql rate :control) #'smooth-clip-q.kr #'smooth-clip-q.ar))) 113 | (funcall select-ugen case-var 114 | (list (funcall smooth-clip-ugen in lo hi smooth-amount delta) 115 | (funcall smooth-clip-ugen (funcall fold-ugen in lo thr-1) lo thr-1 smooth-amount delta) 116 | (funcall smooth-clip-ugen (funcall fold-ugen in thr-2 hi) thr-2 hi smooth-amount delta))))) 117 | 118 | (defun smooth-fold-q.ar (in &optional (lo -1.0) (hi 1.0) (fold-range 1.0) (smooth-amount 0.5) (delta 0.00001)) 119 | (multinew #'smooth-fold-q-gen :audio in lo hi fold-range smooth-amount delta)) 120 | 121 | (defun smooth-fold-q.kr (in &optional (lo -1.0) (hi 1.0) (fold-range 1.0) (smooth-amount 0.5) (delta 0.00001)) 122 | (multinew #'smooth-fold-q-gen :control in lo hi fold-range smooth-amount delta)) 123 | 124 | 125 | (defun smooth-fold-q2-gen (rate in lo hi fold-range-lo fold-range-hi smooth-amount delta) 126 | (let* ((fold-ugen (if (eql rate :control) #'fold.kr #'fold.ar)) 127 | (case-var (+~ (<~ in lo) (*~ (>~ in hi) 2.0))) 128 | (range-abs (-~ hi lo)) 129 | (thr-1 (+~ lo (*~ range-abs fold-range-lo))) 130 | (thr-2 (-~ hi (*~ range-abs fold-range-hi))) 131 | (select-ugen (if (eql rate :control) #'select.kr #'select.ar)) 132 | (smooth-clip-ugen (if (eql rate :control) #'smooth-clip-q.kr #'smooth-clip-q.ar))) 133 | (funcall select-ugen case-var 134 | (list (funcall smooth-clip-ugen in lo hi smooth-amount delta) 135 | (funcall smooth-clip-ugen (funcall fold-ugen in lo thr-1) lo thr-1 smooth-amount delta) 136 | (funcall smooth-clip-ugen (funcall fold-ugen in thr-2 hi) thr-2 hi smooth-amount delta))))) 137 | 138 | (defun smooth-fold-q2.ar (in &optional (lo -1.0) (hi 1.0) (fold-range-lo 1.0) (fold-range-hi 1.0) (smooth-amount 0.5) (delta 0.00001)) 139 | (multinew #'smooth-fold-q2-gen :audio in lo hi fold-range-lo fold-range-hi smooth-amount delta)) 140 | 141 | (defun smooth-fold-q2.kr (in &optional (lo -1.0) (hi 1.0) (fold-range-lo 1.0) (fold-range-hi 1.0) (smooth-amount 0.5) (delta 0.00001)) 142 | (multinew #'smooth-fold-q2-gen :control in lo hi fold-range-lo fold-range-hi smooth-amount delta)) 143 | 144 | 145 | (export '(smooth-clip-s.ar smooth-clip-s.kr smooth-clip-q.ar smooth-clip-q.kr 146 | smooth-fold-s.ar smooth-fold-s.kr smooth-fold-s2.ar smooth-fold-s2.kr 147 | smooth-fold-q.ar smooth-fold-q.kr smooth-fold-q2.ar smooth-fold-q2.kr)) 148 | 149 | -------------------------------------------------------------------------------- /ugens/Extensions/PortedPlugins.lisp: -------------------------------------------------------------------------------- 1 | ;; 2 | ;; https://github.com/madskjeldgaard/portedplugins 3 | ;; 4 | 5 | (in-package :sc) 6 | 7 | 8 | (defugen (analog-bass-drum "AnalogBassDrum") 9 | (trig &key (infsustain 0.0) (accent 0.5) (freq 50) (tone 0.5) (decay 0.5) (attackfm 0.5) (selffm 0.25)) 10 | ((:ar (multinew new 'ugen trig infsustain accent freq tone decay attackfm selffm)))) 11 | 12 | 13 | (defugen (analog-phaser-mod "AnalogPhaserMod") 14 | (input &key (skew 0) (modulation 0.5) (stages 8)) 15 | ((:ar (multinew new 'ugen input skew modulation stages)) 16 | (:kr (multinew new 'ugen input skew modulation stages)))) 17 | 18 | 19 | (defugen (analog-phaser "AnalogPhaser") 20 | (input lfoinput &key (skew 0) (feedback .25) (modulation .5) (stages 8)) 21 | ((:ar (multinew new 'ugen input lfoinput skew feedback modulation stages)))) 22 | 23 | 24 | (defugen (analog-snare-drum "AnalogSnareDrum") 25 | (trig &key (infsustain 0) (accent .1) (freq 200) (tone .5) (decay .5) (snappy .5)) 26 | ((:ar (multinew new 'ugen trig infsustain accent freq tone decay snappy)))) 27 | 28 | 29 | (defugen (analog-tape "AnalogTape") 30 | (input &key (bias .5) (saturation .5) (drive .5) (oversample 1) (mode 0)) 31 | ((:ar (multinew new 'ugen input bias saturation drive oversample mode)))) 32 | 33 | 34 | (defugen (analog-vintage-distortion "AnalogVintageDistortion") 35 | (input &key (drivegain .5) (bias 0) (lowgain .1) (highgain .1) (shelvingfreq 600) (oversample 0)) 36 | ((:ar (multinew new 'ugen input drivegain bias lowgain highgain shelvingfreq oversample)))) 37 | 38 | 39 | ;; AnalogChew 40 | ;; AnalogLoss 41 | ;; AnalogDegrade 42 | 43 | (defugen (analog-fold-osc "AnalogFoldOsc") 44 | (&optional (freq 100) (amp 1)) 45 | ((:ar (multinew new 'ugen freq amp)))) 46 | 47 | 48 | (defugen (bl-osc "BLOsc") 49 | (&optional (freq 100) (pulsewidth .5) (waveform 0)) 50 | ((:ar (multinew new 'ugen freq pulsewidth waveform)) 51 | (:kr (multinew new 'ugen freq pulsewidth waveform)))) 52 | 53 | 54 | (defugen (chen "Chen") 55 | (&optional (speed .5) &key (a .5) (b .3) (c .28)) 56 | ((:ar (multinew new 'multiout-ugen 3 speed a b c)) 57 | (:kr (multinew new 'multiout-ugen 3 speed a b c))) 58 | :check-fn (lambda (ugen) 59 | (dolist (input (inputs ugen)) 60 | (unless (find (rate input) (list :scalar :control)) 61 | (error "input rate sholud be scalar or control"))))) 62 | 63 | 64 | (defugen (d-compressor "DCompressor") 65 | (input &optional (sidechain-in 0) &key (sidechain 0) (ratio 4) (threshold -40) (attack .1) (release 100.1) (makeup .5) (automakeup 1)) 66 | ((:ar (multinew new 'ugen input sidechain-in sidechain ratio threshold attack release makeup automakeup)))) 67 | 68 | 69 | (defugen (harmonic-osc "HarmonicOsc") 70 | (&optional (freq 100) (firstharmonic 1) amplitudes) 71 | ((:ar (apply #'multinew new 'ugen freq firstharmonic amplitudes)) 72 | (:kr (apply #'multinew new 'ugen freq firstharmonic amplitudes)))) 73 | 74 | 75 | (defugen (lpg "LPG") 76 | (input controlinput &key (controloffset 0) (controlscale 1) (vca 1) (resonance 1.5) (lowpassmode 1) (linearity 1)) 77 | ((:ar (multinew new 'ugen input controlinput controloffset controlscale vca resonance lowpassmode linearity))) 78 | :check-fn (lambda (ugen) 79 | (let* ((inputs (inputs ugen))) 80 | (assert (and (eql (rate (first inputs)) :audio) 81 | (find (rate (second inputs)) (list :control :audio)) 82 | (every #'identity (mapcar (lambda (input) (find (rate input) (list :control :scalar))) (cddr inputs)))))))) 83 | 84 | 85 | (defugen (lockhart-wavefolder "LockhartWavefolder") 86 | (input &optional (num-cells 4)) 87 | ((:ar (multinew new 'ugen input num-cells)) 88 | (:kr (multinew new 'ugen input num-cells)))) 89 | 90 | 91 | (defugen (neo-formant "NeoFormant") 92 | (&optional (formantfreq 100) (carrierfreq 200) (phaseshift .5)) 93 | ((:ar (multinew new 'ugen formantfreq carrierfreq phaseshift)) 94 | (:kr (multinew new 'ugen formantfreq carrierfreq phaseshift)))) 95 | 96 | 97 | (defugen (neo-var-saw-osc "NeoVarSawOsc") 98 | (&optional (freq 100) (pw .5) (waveshape .5)) 99 | ((:ar (multinew new 'ugen freq pw waveshape)) 100 | (:kr (multinew new 'ugen freq pw waveshape)))) 101 | 102 | 103 | (defugen (nonlinear-filter "NonlinearFilter") 104 | (input &optional (freq 500) (q .5) &key (gain 1) (shape 5) (saturation 3)) 105 | ((:ar (multinew new 'ugen input freq q gain shape saturation)) 106 | (:kr (multinew new 'ugen input freq q gain shape saturation)))) 107 | 108 | 109 | (defugen (osc-bank "OscBank") 110 | (&optional (freq 100) (gain 1) &key (saw8 .5) (square8 .5) (saw4 .5) (square4 .5) (saw2 .5) (square2 .5) (saw1 .5)) 111 | ((:ar (multinew new 'ugen freq gain saw8 square8 saw4 square4 saw2 square2 saw1)) 112 | (:kr (multinew new 'ugen freq gain saw8 square8 saw4 square4 saw2 square2 saw1)))) 113 | 114 | 115 | (defugen (phasor-modal "PhasorModal") 116 | (input &key (freq 100) (decay .25) (damp 1) (amp .5) (phase .0)) 117 | ((:ar (multinew new 'ugen input freq decay damp amp phase)))) 118 | 119 | 120 | (defugen (resonator "Resonator") 121 | (input &key (freq 100) (position .001) (resolution 24) (structure .5) (brightness .5) (damping .5)) 122 | ((:ar (multinew new 'ugen input freq position resolution structure brightness damping)))) 123 | 124 | 125 | (defugen (rongs "Rongs") 126 | (&key (trigger 0) (sustain 1) (f0 .01) (structure .5) (brightness .5) (damping .75) (accent .9) (stretch .5) (position .15) (loss .15) (mode-num 2) (cos-freq .25)) 127 | ((:ar (multinew new 'ugen trigger sustain f0 structure brightness damping accent stretch position loss mode-num cos-freq))) 128 | :check-fn (lambda (ugen) 129 | (destructuring-bind (trigger sustain f0 structure brightness damping accent stretch position loss mode-num cos-freq) 130 | (mapcar #'rate (inputs ugen)) 131 | (assert (and (eql mode-num :scalar) 132 | (eql cos-freq :scalar) 133 | (find trigger (list :control :scalar :audio)) 134 | (every #'identity (mapcar (lambda (in) (find in (list :control :scalar))) 135 | (list sustain f0 structure brightness damping accent stretch position loss)))))))) 136 | 137 | 138 | (defugen (string-voice "StringVoice") 139 | (&key (trig 0) (infsustain 0) (freq 100) (accent .5) (structure .5) (brightness .5) (damping .5)) 140 | ((:ar (multinew new 'ugen trig infsustain freq accent structure brightness damping)))) 141 | 142 | 143 | (defugen (vadim-filter "VadimFilter") 144 | (input &optional (freq 500) (resonance 1.0) (type 0)) 145 | ((:ar (multinew new 'ugen input freq resonance type)))) 146 | 147 | 148 | (defugen (var-shape-osc "VarShapeOsc") 149 | (&optional (freq 100) (pw .5) (waveshape .5) (sync 1) (syncfreq 105)) 150 | ((:ar (multinew new 'ugen freq pw waveshape sync syncfreq)) 151 | (:kr (multinew new 'ugen freq pw waveshape sync syncfreq)))) 152 | 153 | 154 | (defugen (vosim-osc "VosimOsc") 155 | (&optional (freq 100) (form1freq 951) (form2freq 919) (shape 0)) 156 | ((:ar (multinew new 'ugen freq form1freq form2freq shape)) 157 | (:kr (multinew new 'ugen freq form1freq form2freq shape)))) 158 | 159 | 160 | (defugen (z-osc "ZOsc") 161 | (&optional (freq 100) (formantfreq 91) (shape .5) (mode .5)) 162 | ((:ar (multinew new 'ugen freq formantfreq shape mode)) 163 | (:kr (multinew new 'ugen freq formantfreq shape mode)))) 164 | 165 | 166 | ;; VAOnePoleFilter 167 | 168 | (defugen (va-diode-filter "VADiodeFilter") 169 | (input &optional (freq 500) (res .1) (overdrive 0)) 170 | ((:ar (multinew new 'ugen input freq res overdrive)) 171 | (:kr (multinew new 'ugen input freq res overdrive)))) 172 | 173 | 174 | (defugen (va-korg35 "VAKorg35") 175 | (input &optional (freq 500) (res .1) (overdrive 0) (type 0)) 176 | ((:ar (multinew new 'ugen input freq res overdrive type)) 177 | (:kr (multinew new 'ugen input freq res overdrive type)))) 178 | 179 | 180 | (defugen (va-ladder "VALadder") 181 | (input &optional (freq 500) (res .1) (overdrive 0) (type 0)) 182 | ((:ar (multinew new 'ugen input freq res overdrive type)) 183 | (:kr (multinew new 'ugen input freq res overdrive type)))) 184 | 185 | 186 | (defugen (va-sem12 "VASEM12") 187 | (input &optional (freq 500) (res .1) (transition 0)) 188 | ((:ar (multinew new 'ugen input freq res transition)) 189 | (:kr (multinew new 'ugen input freq res transition)))) 190 | 191 | 192 | 193 | -------------------------------------------------------------------------------- /ugens/Trig.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defugen (trig-1 "Trig1") (&optional (in 0.0) (dur 0.1)) 4 | ((:ar (multinew new 'ugen in dur)) 5 | (:kr (multinew new 'ugen in dur))) 6 | :signal-range :unipolar) 7 | 8 | (defugen (trig "Trig") (&optional (in 0.0) (dur 0.1)) 9 | ((:ar (multinew new 'ugen in dur)) 10 | (:kr (multinew new 'ugen in dur))) 11 | :signal-range :unipolar) 12 | 13 | (defugen (send-trig "SendTrig") 14 | (&optional (in 0.0) (id 0) (value 0.0)) 15 | ((:ar (progn (multinew new 'nooutput-ugen in id value) 0.0)) 16 | (:kr (progn (multinew new 'nooutput-ugen in id value) 0.0))) 17 | :check-fn #'check-same-rate-as-first-input) 18 | 19 | (defugen (send-reply "SendReply") 20 | (&optional (trig 0.0) (cmd "/reply") values (reply-id -1)) 21 | ((:kr 22 | (let ((values (alexandria:ensure-list values))) 23 | (unless (find-if #'listp values) (setf values (bubble values))) 24 | (dolist (args (flop (list trig cmd values reply-id))) 25 | (destructuring-bind (trig cmd value rep-id) args 26 | (let ((arg (list trig rep-id (length cmd)))) 27 | (apply #'multinew new 'nooutput-ugen 28 | (append arg (map 'list #'char-code cmd) (alexandria:ensure-list value)))))) 29 | 0.0)) 30 | (:ar 31 | (let ((values (alexandria:ensure-list values))) 32 | (unless (find-if #'listp values) (setf values (bubble values))) 33 | (dolist (args (flop (list trig cmd values reply-id))) 34 | (destructuring-bind (trig cmd value rep-id) args 35 | (let ((arg (list trig rep-id (length cmd)))) 36 | (apply #'multinew new 'nooutput-ugen 37 | (append arg (map 'list #'char-code cmd) (alexandria:ensure-list value)))))) 38 | 0.0)))) 39 | 40 | 41 | (defugen (t-delay "TDelay") (&optional (in 0.0) (dur 0.1)) 42 | ((:ar (multinew new 'ugen in dur)) 43 | (:kr (multinew new 'ugen in dur))) 44 | :check-fn #'check-same-rate-as-first-input) 45 | 46 | (defugen (latch "Latch") (&optional (in 0.0) (trig 0.0)) 47 | ((:ar (multinew new 'ugen in trig)) 48 | (:kr (multinew new 'ugen in trig)))) 49 | 50 | (defugen (gate "Gate") (&optional (in 0.0) (trig 0.0)) 51 | ((:ar (multinew new 'ugen in trig)) 52 | (:kr (multinew new 'ugen in trig)))) 53 | 54 | (defugen (pulse-count "PulseCount") 55 | (&optional (trig 0.0) (reset 0.0)) 56 | ((:ar (multinew new 'ugen trig reset)) 57 | (:kr (multinew new 'ugen trig reset))) 58 | :check-fn #'check-same-rate-as-first-input) 59 | 60 | 61 | (defun peak-check-fn (ugen) 62 | (if (and (eql (rate ugen) :control) (eql (rate (nth 0 (inputs ugen))) :audio)) 63 | (error "valid inputs") 64 | (check-same-rate-as-first-input ugen))) 65 | 66 | (defugen (peak "Peak") (&optional (in 0.0) (trig 0.0)) 67 | ((:ar (multinew new 'ugen in trig)) 68 | (:kr (multinew new 'ugen in trig))) 69 | :check-fn #'peak-check-fn) 70 | 71 | (defugen (running-min "RunningMin") 72 | (&optional (in 0.0) (trig 0.0)) 73 | ((:ar (multinew new 'ugen in trig)) 74 | (:kr (multinew new 'ugen in trig))) 75 | :check-fn #'peak-check-fn) 76 | 77 | (defugen (running-max "RunningMax") 78 | (&optional (in 0.0) (trig 0.0)) 79 | ((:ar (multinew new 'ugen in trig)) 80 | (:kr (multinew new 'ugen in trig))) 81 | :check-fn #'peak-check-fn) 82 | 83 | 84 | 85 | (defugen (stepper "Stepper") 86 | (&optional (trig 0.0) (reset 0) (min 0) (max 7) (step 1) reset-val) 87 | ((:ar (multinew new 'ugen trig reset min max step (if reset-val reset-val min))) 88 | (:kr (multinew new 'ugen trig reset min max step (if reset-val reset-val min)))) 89 | :check-fn #'check-same-rate-as-first-input) 90 | 91 | (defugen (pulse-divider "PulseDivider") (&optional (trig 0.0) (div 2.0) (start 0.0)) 92 | ((:ar (multinew new 'ugen trig div start)) 93 | (:kr (multinew new 'ugen trig div start)))) 94 | 95 | 96 | (defugen (set-reset-ff "SetResetFF") 97 | (&optional (trig 0.0) (reset 0.0)) 98 | ((:ar (multinew new 'ugen trig reset)) 99 | (:kr (multinew new 'ugen trig reset))) 100 | :check-fn #'check-same-rate-as-first-input) 101 | 102 | (defugen (toggle-ff "ToggleFF") (&optional (trig 0.0)) 103 | ((:ar (multinew new 'ugen trig)) 104 | (:kr (multinew new 'ugen trig)))) 105 | 106 | (defugen (zero-crossing "ZeroCrossing") (&optional (in 0.0)) 107 | ((:ar (multinew new 'ugen in)) 108 | (:kr (multinew new 'ugen in))) 109 | :check-fn #'check-same-rate-as-first-input) 110 | 111 | (defugen (timer "Timer") (&optional (trig 0.0)) 112 | ((:ar (multinew new 'ugen trig)) 113 | (:kr (multinew new 'ugen trig))) 114 | :check-fn #'check-same-rate-as-first-input) 115 | 116 | (defugen (sweep "Sweep") 117 | (&optional (trig 0.0) (srate 1.0)) 118 | ((:ar (multinew new 'ugen trig srate)) 119 | (:kr (multinew new 'ugen trig srate)))) 120 | 121 | (defugen (phasor "Phasor") 122 | (&optional (trig 0.0) (srate 1.0) (start 0.0) (end 1.0) (reset-pos 0.0)) 123 | ((:ar (multinew new 'ugen trig srate start end reset-pos)) 124 | (:kr (multinew new 'ugen trig srate start end reset-pos)))) 125 | 126 | (defugen (peak-follower "PeakFollower") (&optional (in 0.0) (decay 0.999)) 127 | ((:ar (multinew new 'ugen in decay)) 128 | (:kr (multinew new 'ugen in decay)))) 129 | 130 | 131 | (defugen (pitch "Pitch") 132 | (&optional (in 0.0) (init-freq 440.0) (min-freq 60.0) (max-freq 4000.0) 133 | (exec-freq 100.0) (max-bins-per-octave 16) (median 1) 134 | (amp-threshold 0.01) (peak-threshold 0.5) (down-sample 1) (clar 0.0)) 135 | ((:kr (multinew new 'multiout-ugen 2 in init-freq min-freq max-freq exec-freq max-bins-per-octave 136 | median amp-threshold peak-threshold down-sample clar)))) 137 | 138 | (defugen (coyote "Coyote") 139 | (&optional (in 0.0) (track-fall 0.2) (slow-lag 0.2) (fast-lag 0.01) (fast-mul 0.5) (thresh 0.05) (min-dur 0.1)) 140 | ((:kr (multinew new 'ugen in track-fall slow-lag fast-lag fast-mul thresh min-dur)))) 141 | 142 | (defugen (in-range "InRange") 143 | (&optional (in 0.0) (lo 0.0) (hi 1.0)) 144 | ((:ar (multinew new 'ugen in lo hi)) 145 | (:kr (multinew new 'ugen in lo hi)))) 146 | 147 | (defugen (fold "Fold") 148 | (&optional (in 0.0) (lo 0.0) (hi 1.0)) 149 | ((:ir (let* ((x (-~ in lo)) 150 | (range (-~ hi lo)) 151 | (range2 (+~ range range)) 152 | (c (-~ x (*~ range2 (floor~ (/~ x range2))))) 153 | (c (if~ (>=~ c range) (-~ range2 c) c))) 154 | (+~ c lo))) 155 | (:ar (multinew new 'ugen in lo hi)) 156 | (:kr (multinew new 'ugen in lo hi)))) 157 | 158 | (defmethod fold (in &optional (lo 0.0) (hi 1.0)) 159 | (let ((rate (rate (list in lo hi)))) 160 | (funcall (case rate 161 | (:scalar #'fold.ir) 162 | (:audio #'fold.ar) 163 | (:control #'fold.kr)) 164 | in lo hi))) 165 | 166 | (defugen (clip "Clip") (&optional (in 0.0) (lo 0.0) (hi 1.0)) 167 | ((:ir (max~ (min~ in hi) lo)) 168 | (:ar (multinew new 'ugen in lo hi)) 169 | (:kr (multinew new 'ugen in lo hi)))) 170 | 171 | (defmethod clip (in &optional (lo 0.0) (hi 1.0)) 172 | (let ((rate (rate (list in lo hi)))) 173 | (funcall (case rate 174 | (:scalar #'clip.ir) 175 | (:audio #'clip.ar) 176 | (:control #'clip.kr)) 177 | in lo hi))) 178 | 179 | (defugen (wrap "Wrap") 180 | (&optional (in 0.0) (lo 0.0) (hi 1.0)) 181 | ((:ir (+~ (mod~ (-~ in lo) (-~ hi lo)) lo)) 182 | (:ar (multinew new 'ugen in lo hi)) 183 | (:kr (multinew new 'ugen in lo hi)))) 184 | 185 | (defmethod wrap (in &optional (lo 0.0) (hi 1.0)) 186 | (let ((rate (rate (list in lo hi)))) 187 | (funcall (case rate 188 | (:scalar #'wrap.ir) 189 | (:audio #'wrap.ar) 190 | (:control #'wrap.kr)) 191 | in lo hi))) 192 | 193 | (defugen (Schmidt "Schmidt") 194 | (&optional (in 0.0) (lo 0.0) (hi 1.0)) 195 | ((:ar (multinew new 'ugen in lo hi)) 196 | (:kr (multinew new 'ugen in lo hi)))) 197 | 198 | (defugen (most-change "MostChange") 199 | (&optional (a 0.0) (b 0.0)) 200 | ((:ar (multinew new 'ugen a b)) 201 | (:kr (multinew new 'ugen a b)))) 202 | 203 | (defugen (least-change "LeastChange") 204 | (&optional (a 0.0) (b 0.0)) 205 | ((:ar (multinew new 'ugen a b)) 206 | (:kr (multinew new 'ugen a b)))) 207 | 208 | (defugen (last-value "LastValue") 209 | (&optional (in 0.0) (diff 0.01)) 210 | ((:ar (multinew new 'ugen in diff)) 211 | (:kr (multinew new 'ugen in diff)))) 212 | 213 | 214 | 215 | (defclass send-peak-rms (ugen) 216 | ()) 217 | 218 | (defmethod num-outputs ((ugen send-peak-rms)) 219 | 0) 220 | 221 | (defugen (send-peak-rms "SendPeakRMS") 222 | (sig &optional (reply-rate 20.0) (peak-lag 3) (cmd-name "/reply") (reply-id -1)) 223 | ((:ar (progn (apply new 'send-peak-rms reply-rate peak-lag reply-id (length (alexandria:ensure-list sig)) 224 | (append (alexandria:ensure-list sig) (list (length cmd-name)) (map 'list #'char-code cmd-name))) 225 | 0)) 226 | (:kr (progn (apply new 'send-peak-rms reply-rate peak-lag reply-id (length (alexandria:ensure-list sig)) 227 | (append (alexandria:ensure-list sig) (list (length cmd-name)) (map 'list #'char-code cmd-name))) 228 | 0)))) 229 | 230 | -------------------------------------------------------------------------------- /ugens/Extensions/f0plugins.lisp: -------------------------------------------------------------------------------- 1 | ;; 2 | ;; https://github.com/redFrik/f0plugins 3 | ;; 4 | 5 | (in-package :sc) 6 | 7 | ;; AY8910 8 | (defugen (ay8910 "AY8910") 9 | (&key (r0 0) (r1 0) (r2 0) (r3 0) (r4 0) (r5 0) (r6 0) (r7 0) (r8 0) (r9 0) (ra 0) (rb 0) (rc 0) (rd 0) (rate 1)) 10 | ((:ar (multinew new 'multiout-ugen 3 r0 r1 r2 r3 r4 r5 r6 r7 r8 r9 ra rb rc rd rate)))) 11 | 12 | 13 | (defun ay8910-square.ar (&optional (freq 100) (noise 15) (ctrl 0) (vol 15) (env-rate 200) (env-shape 14) (rate 1)) 14 | (let* ((r0 (mod~ freq 256)) 15 | (r1 (clip.kr (/~ freq 256) 0 15)) 16 | (r6 (clip.kr noise 0 31)) 17 | (control (clip.kr ctrl 0 7)) 18 | (enable0 (>~ (mod~ control 2) 0)) 19 | (enable1 (>~ (mod~ (floor~ (/~ control 2)) 2) 0)) 20 | (enable2 (>~ (mod~ (floor~ (/~ control 4)) 4) 0)) 21 | (r7 (+~ enable0 (*~ enable1 8))) 22 | (r8 (+~ (clip.kr vol 0 15) (*~ enable2 16))) 23 | (rb (mod~ env-rate 256)) 24 | (rc (clip.kr (/~ env-rate 256) 0 255)) 25 | (rd (clip.kr env-shape 0 15))) 26 | (ay8910.ar :r0 r0 :r1 r1 :r2 0 :r3 0 :r4 0 :r5 0 :r6 r6 27 | :r7 r7 :r8 r8 :r9 0 :ra 0 :rb rb :rc rc :rd rd :rate rate))) 28 | 29 | (export 'ay8910-square.ar) 30 | 31 | 32 | ;; Astrocade 33 | (defugen (astrocade "Astrocade") 34 | (&key (reg0 0) (reg1 127) (reg2 0) (reg3 0) (reg4 0) (reg5 0) (reg6 15) (reg7 0)) 35 | ((:ar (multinew new 'ugen reg0 reg1 reg2 reg3 reg4 reg5 reg6 reg7)))) 36 | 37 | 38 | ;; Atari2600 39 | (defugen (atari2600 "Atari2600") 40 | (&optional (audc0 1) (audc1 2) (audf0 3) (audf1 4) (audv0 5) (audv1 5) (rate 1)) 41 | ((:ar (multinew new 'ugen audc0 audc1 audf0 audf1 audv0 audv1 rate)))) 42 | 43 | ;; Beep 44 | (defugen (beep "BeepU") (&optional (freq 3250) (vol 1)) 45 | ((:ar (multinew new 'ugen freq vol)))) 46 | 47 | 48 | ;; Dbjorklund 49 | (def-dugen (d-bjorklund "Dbjorklund") (&optional (k 4) (n 8) (offset 0) (length +inf+)) 50 | (multinew new 'dugen length k n offset)) 51 | 52 | (def-dugen (d-bjorklund2 "Dbjorklund2") (&optional (k 4) (n 8) (offset 0) (length +inf+)) 53 | (progn 54 | (when (and (numberp k) (<= k 0)) 55 | (error "k must be >= 1")) 56 | (multinew new 'dugen length k n offset))) 57 | 58 | 59 | 60 | ;; Dsieve 61 | 62 | 63 | ;; MZPokey 64 | (defugen (mz-pokey "MZPokey") 65 | (&optional (audf1 0) (audc1 0) &key (audf2 0) (audc2 0) (audf3 0) (audc3 0) (audf4 0) (audc4 0) (audctl 0)) 66 | ((:ar (multinew new 'ugen audf1 audc1 audf2 audc2 audf3 audc3 audf4 audc4 audctl)))) 67 | 68 | 69 | ;; Nes2 70 | (defugen (nes2 "Nes2") (&optional (trig 0) &key (a0 0) (a1 0) (a2 0) (a3 0) (b0 0) (b1 0) (b2 0) (b3 0) (c0 0) (c2 0) (c3 0) (d0 0) (d2 0) (d3 0) (e0 0) (e1 0) (e2 0) (e3 0) (smask 0)) 71 | ((:ar (multinew new 'ugen trig a0 a1 a2 a3 b0 b1 b2 b3 c0 c2 c3 d0 d2 d3 e0 e1 e2 e3 smask)))) 72 | 73 | (defun nes2-square.ar (&optional (trig 0) (dutycycle 0) (loopenv 0) (envdecay 0) (vol 10) (sweep 0) (sweeplen 0) (sweepdir 0) (sweepshi 0) (freq 100) (vbl 0)) 74 | (let* ((a0 (*~ (clip.kr (round~ dutycycle) 0 3) 64)) 75 | (a0 (logior~ a0 (*~ (clip.kr (round~ loopenv) 0 1) 32))) 76 | (a0 (logior~ a0 (*~ (clip.kr (round~ envdecay) 0 1) 16))) 77 | (a0 (logior~ a0 (clip.kr (round~ vol) 0 15))) 78 | (a1 (*~ (clip.kr (round~ sweep) 0 1) 128)) 79 | (a1 (logior~ a1 (*~ (clip.kr (round~ sweeplen) 0 7) 16))) 80 | (a1 (logior~ a1 (*~ (clip.kr (round~ sweepdir) 0 1) 8))) 81 | (a1 (logior~ a1 (clip.kr (round~ sweepshi) 0 7))) 82 | (a2 (mod~ (round~ (max~ freq 0)) 256)) 83 | (a3 (clip.kr (floor~ (/~ freq 256)) 0 7)) 84 | (a3 (logior~ a3 (*~ (clip.kr (round~ vbl) 0 31) 8)))) 85 | (nes2.ar trig :a0 a0 :a1 a1 :a2 a2 :a3 a3 :smask 1))) 86 | 87 | (defun nes2-triangle.ar (&optional (trig 0) (start 0) (counter 10) (freq 100) (vbl 0)) 88 | (let* ((c0 (*~ (clip.kr (round~ start) 0 1) 128)) 89 | (c0 (logior~ c0 (clip.kr (round~ counter) 0 127))) 90 | (c2 (mod~ (round~ (max~ freq 0)) 256)) 91 | (c3 (clip.kr (floor~ (/~ freq 256)) 0 7)) 92 | (c3 (logior~ c3 (*~ (clip.kr (round~ vbl) 0 31) 8)))) 93 | (nes2.ar trig :c0 c0 :c2 c2 :c3 c3 :smask 4))) 94 | 95 | (defun nes2-noise.ar (&optional (trig 0) (loopenv 0) (envdecay 0) (vol 10) (short 0) (freq 10) (vbl 0)) 96 | (let* ((d0 (*~ (clip.kr (round~ loopenv) 0 1) 32)) 97 | (d0 (logior~ d0 (*~ (clip.kr (round~ envdecay) 0 1) 16))) 98 | (d0 (logior~ d0 (clip.kr (round~ vol) 0 15))) 99 | (d2 (*~ (clip.kr (round~ short) 0 1) 128)) 100 | (d2 (logior~ d2 (clip.kr (round~ freq) 0 15))) 101 | (d3 (*~ (clip.kr (round~ vbl) 0 31) 8))) 102 | (nes2.ar trig :d0 d0 :d2 d2 :d3 d3 :smask 8))) 103 | 104 | (defun nes2-dmc.ar (&optional (trig) (loop 0) (freq 1)) 105 | (let* ((e0 (*~ (clip.kr (round~ loop) 0 1) 64)) 106 | (e0 (logior~ e0 (clip.kr (round~ freq) 0 7))) 107 | (e1 0) 108 | (e2 0) 109 | (e3 0)) 110 | (nes2.ar trig :e0 e0 :e1 e1 :e2 e2 :e3 e3 :smask 16))) 111 | 112 | (export '(nes2-square.ar nes2-triangle.ar nes2-noise.ar nes2-dmc.ar)) 113 | 114 | ;; Pokey 115 | (defugen (pokey "Pokey") 116 | (&optional (audf1 0) (audc1 0) (audf2 0) (audc2 0) (audf3 0) (audc3 0) (audf4 0) (audc4 0) (audctl 0)) 117 | ((:ar (multinew new 'ugen audf1 audc1 audf2 audc2 audf3 audc3 audf4 audc4 audctl)))) 118 | 119 | (defun pokey-square.ar (&optional (freq1 0) (tone1 0) (vol1 0) (freq2 0) (tone2 0) (vol2 0) (freq3 0) (tone3 0) (vol3 0) (freq4 0) (tone4 0) (vol4 0) (ctrl 0)) 120 | (pokey.ar (clip.kr freq1 0 255) 121 | (logior~ (*~ (clip.kr (round~ tone1) 0 7) 32) (clip.kr (round~ vol1) 0 15)) 122 | (clip.kr freq2 0 255) 123 | (logior~ (*~ (clip.kr (round~ tone2) 0 7) 32) (clip.kr (round~ vol2) 0 15)) 124 | (clip.kr freq3 0 255) 125 | (logior~ (*~ (clip.kr (round~ tone3) 0 7) 32) (clip.kr (round~ vol3) 0 15)) 126 | (clip.kr freq4 0 255) 127 | (logior~ (*~ (clip.kr (round~ tone4) 0 7) 32) (clip.kr (round~ vol4) 0 15)) 128 | (+~ (*~ (round~ (-~ (mod~ (round~ ctrl) 64) 1) 2) 4) 129 | (mod~ (round~ ctrl) 2)))) 130 | 131 | (export '(pokey-square.ar)) 132 | 133 | 134 | ;; RedDPCM 135 | (defugen (red-dpcm-encode "RedDPCMencode") 136 | (&optional (in 0.0) (round 0.0)) 137 | ((:ar (multinew new 'pure-ugen in round)) 138 | (:kr (multinew new 'pure-ugen in round))) 139 | :check-fn #'check-same-rate-as-first-input) 140 | 141 | (defugen (red-dpcm-decode "RedDPCMdecode") 142 | (&optional (in 0.0)) 143 | ((:ar (multinew new 'pure-ugen in)) 144 | (:kr (multinew new 'pure-ugen in))) 145 | :check-fn #'check-same-rate-as-first-input) 146 | 147 | 148 | ;; RedLbyl 149 | (defugen (red-lbyl "RedLbyl") 150 | (&optional (in 0.0) (thresh 0.5) (samples 2)) 151 | ((:ar (multinew new 'pure-ugen in thresh samples)) 152 | (:kr (multinew new 'pure-ugen in thresh samples))) 153 | :check-fn #'check-same-rate-as-first-input) 154 | 155 | ;; RedNoise 156 | (defugen (red-noise "RedNoise") 157 | (&optional (clock 0) (mul 1) (add 0)) 158 | ((:ar (madd (multinew new 'ugen clock) mul add)) 159 | (:kr (madd (multinew new 'ugen clock) mul add)))) 160 | 161 | ;; RedPhasor 162 | (defugen (red-phasor "RedPhasor") 163 | (&optional (trig 0.0) (rate 1) (start 0) (end 1) &key (loop 0) (loop-start 0) (loop-end 1)) 164 | ((:ar (multinew new 'ugen trig rate start end loop loop-start loop-end)) 165 | (:kr (multinew new 'ugen trig rate start end loop loop-start loop-end)))) 166 | 167 | (defugen (red-phasor2 "RedPhasor2") 168 | (&optional (trig 0.0) (rate 1) (start 0) (end 1) &key (loop 0) (loop-start 0) (loop-end 1)) 169 | ((:ar (multinew new 'ugen trig rate start end loop loop-start loop-end)) 170 | (:kr (multinew new 'ugen trig rate start end loop loop-start loop-end)))) 171 | 172 | ;; SID6581f 173 | (defugen (sid6581f "SID6581f") 174 | (&optional (freq-lo0 0) (freq-hi0 0) (pw-lo0 0) (pw-hi0 0) (ctrl0 0) (atk-dcy0 0) (sus-rel0 0) 175 | (freq-lo1 0) (freq-hi1 0) (pw-lo1 0) (pw-hi1 0) (ctrl1 0) (atk-dcy1 0) (sus-rel1 0) 176 | (freq-lo2 0) (freq-hi2 0) (pw-lo2 0) (pw-hi2 0) (ctrl2 0) (atk-dcy2 0) (sus-rel2 0) 177 | (fc-lo 0) (fc-hi 0) (res-filt 0) (mode-vol 0) (rate 1)) 178 | ((:ar (multinew new 'ugen freq-lo0 freq-hi0 pw-lo0 pw-hi0 ctrl0 atk-dcy0 sus-rel0 179 | freq-lo1 freq-hi1 pw-lo1 pw-hi1 ctrl1 atk-dcy1 sus-rel1 180 | freq-lo2 freq-hi2 pw-lo2 pw-hi2 ctrl2 atk-dcy2 sus-rel2 181 | fc-lo fc-hi res-filt mode-vol rate)))) 182 | 183 | 184 | ;; SN76489 185 | (defugen (sn76489 "SN76489") 186 | (&optional (tone0 512) (tone1 0) (tone2 0) (noise 0) (vol0 15) (vol1 0) (vol2 0) (vol3 0) (rate 1)) 187 | ((:ar (multinew new 'ugen tone0 tone1 tone2 noise vol0 vol1 vol2 vol3 rate)))) 188 | 189 | 190 | ;; Slub 191 | (defugen (slub "Slub") 192 | (&optional (trig 0.0) (spike 4.04)) 193 | ((:ar (multinew new 'ugen trig spike)) 194 | (:kr (multinew new 'ugen trig spike)))) 195 | 196 | 197 | ;; Tbjorklund 198 | (defugen (t-bjorklund "Tbjorklund") 199 | (&optional (rate 8) (width 0.5) (k 4) (n 8) (offset 0)) 200 | ((:ar (multinew new 'ugen rate width k n offset)) 201 | (:kr (multinew new 'ugen rate width k n offset))) 202 | :signal-range :unipolar) 203 | 204 | ;; Tsieve 205 | 206 | ;; WavesetRepeater 207 | (defugen (waveset-repeater "WavesetRepeater") 208 | (in &optional (repeats 8) (rate 1) (numzc 1) (memlen 0.1) (interpolation 2)) 209 | ((:ar (multinew new 'ugen in repeats rate numzc memlen interpolation)) 210 | (:kr (multinew new 'ugen in repeats rate numzc memlen interpolation)))) 211 | 212 | 213 | -------------------------------------------------------------------------------- /ugens/Osc.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:sc) 2 | 3 | (defugen (osc "Osc") 4 | (bufnum &optional (freq 440.0) (phase 0.0) (mul 1.0) (add 0.0)) 5 | ((:ar 6 | (madd (multinew new 'pure-ugen bufnum freq phase) mul add)) 7 | (:kr 8 | (madd (multinew new 'pure-ugen bufnum freq phase) mul add)))) 9 | 10 | (defugen (sin-osc "SinOsc") 11 | (&optional (freq 440.0) (phase 0.0) (mul 1.0) (add 0.0)) 12 | ((:ar (madd (multinew new 'pure-ugen freq phase) mul add)) 13 | (:kr (madd (multinew new 'pure-ugen freq phase) mul add)))) 14 | 15 | (defugen (sin-osc-fb "SinOscFB") 16 | (&optional (freq 440.0) (feedback 0.0) (mul 1.0) (add 0.0)) 17 | ((:ar 18 | (madd (multinew new 'pure-ugen freq feedback) mul add)) 19 | (:kr 20 | (madd (multinew new 'pure-ugen freq feedback) mul add)))) 21 | 22 | (defugen (osc-n "OscN") 23 | (bufnum &optional (freq 440.0) (phase 0.0) (mul 1.0) (add 0.0)) 24 | ((:ar 25 | (madd (multinew new 'pure-ugen bufnum freq phase) mul add)) 26 | (:kr 27 | (madd (multinew new 'pure-ugen bufnum freq phase) mul add)))) 28 | 29 | (defugen (v-osc "VOsc") 30 | (bufpos &optional (freq 440.0) (phase 0.0) (mul 1.0) (add 0.0)) 31 | ((:ar 32 | (madd (multinew new 'pure-ugen bufpos freq phase) mul add)) 33 | (:kr 34 | (madd (multinew new 'pure-ugen bufpos freq phase) mul add)))) 35 | 36 | (defugen (c-osc "COsc") 37 | (bufnum &optional (freq 440.0) (beats 0.5) (mul 1.0) (add 0.0)) 38 | ((:ar 39 | (madd (multinew new 'pure-ugen bufnum freq beats) mul add)) 40 | (:kr 41 | (madd (multinew new 'pure-ugen bufnum freq beats) mul add)))) 42 | 43 | (defugen (formant "Formant") 44 | (&optional (fund-freq 440.0) (form-freq 1760.0) (bw-freq 880.0) (mul 1.0) (add 0.0)) 45 | ((:ar 46 | (madd (multinew new 'pure-ugen fund-freq form-freq bw-freq) mul add)))) 47 | 48 | (defugen (lf-saw "LFSaw") 49 | (&optional (freq 440.0) (iphase 0.0) (mul 1.0) (add 0.0)) 50 | ((:ar 51 | (madd (multinew new 'pure-ugen freq iphase) mul add)) 52 | (:kr 53 | (madd (multinew new 'pure-ugen freq iphase) mul add)))) 54 | 55 | (defugen (lf-par "LFPar") 56 | (&optional (freq 440.0) (iphase 0.0) (mul 1.0) (add 0.0)) 57 | ((:ar 58 | (madd (multinew new 'pure-ugen freq iphase) mul add)) 59 | (:kr 60 | (madd (multinew new 'pure-ugen freq iphase) mul add)))) 61 | 62 | (defugen (lf-cub "LFCub") 63 | (&optional (freq 440.0) (iphase 0.0) (mul 1.0) (add 0.0)) 64 | ((:ar 65 | (madd (multinew new 'pure-ugen freq iphase) mul add)) 66 | (:kr 67 | (madd (multinew new 'pure-ugen freq iphase) mul add)))) 68 | 69 | (defugen (lf-tri "LFTri") 70 | (&optional (freq 440.0) (iphase 0.0) (mul 1.0) (add 0.0)) 71 | ((:ar 72 | (madd (multinew new 'pure-ugen freq iphase) mul add)) 73 | (:kr 74 | (madd (multinew new 'pure-ugen freq iphase) mul add)))) 75 | 76 | 77 | 78 | (defclass lf-gauss (ugen) 79 | ()) 80 | 81 | (defugen (lf-gauss "LFGauss") 82 | (&optional (duration 1) (width 0.1) &key (iphase 0.0) (loop 1) (action 0)) 83 | ((:ar 84 | (multinew new 'lf-gauss duration width iphase loop action)) 85 | (:kr 86 | (multinew new 'lf-gauss duration width iphase loop action)))) 87 | 88 | (defmethod minval ((ugen lf-gauss)) 89 | (let ((width (nth 1 (inputs ugen)))) 90 | (exp~ (divide 1.0 (mul -2.0 (squared (mul 1.0 width))))))) 91 | 92 | (defmethod _range (cls (ugen lf-gauss) &optional (lo 0.0) (hi 1.0)) 93 | (declare (ignore cls)) 94 | (lin-lin ugen (minval ugen) 1.0 lo hi)) 95 | 96 | 97 | (defugen (lf-pulse "LFPulse") 98 | (&optional (freq 440.0) (iphase 0.0) (width 0.5) (mul 1.0) (add 0.0)) 99 | ((:ar 100 | (madd (multinew new 'pure-ugen freq iphase width) mul add)) 101 | (:kr 102 | (madd (multinew new 'pure-ugen freq iphase width) mul add))) 103 | :signal-range :unipolar) 104 | 105 | (defugen (var-saw "VarSaw") 106 | (&optional (freq 440.0) (iphase 0.0) (width 0.5) (mul 1.0) (add 0.0)) 107 | ((:ar 108 | (madd (multinew new 'pure-ugen freq iphase width) mul add)) 109 | (:kr 110 | (madd (multinew new 'pure-ugen freq iphase width) mul add)))) 111 | 112 | 113 | (defugen (impulse "Impulse") 114 | (&optional (freq 440.0) (phase 0.0) (mul 1.0) (add 0.0)) 115 | ((:ar 116 | (madd (multinew new 'pure-ugen freq phase) mul add)) 117 | (:kr 118 | (madd (multinew new 'pure-ugen freq phase) mul add))) 119 | :signal-range :unipolar) 120 | 121 | 122 | (defugen (sync-saw "SyncSaw") 123 | (&optional (sync-freq 440.0) (saw-freq 440.0) (mul 1.0) (add 0.0)) 124 | ((:ar 125 | (madd (multinew new 'pure-ugen sync-freq saw-freq) mul add)) 126 | (:kr 127 | (madd (multinew new 'pure-ugen sync-freq saw-freq) mul add)))) 128 | 129 | 130 | (defugen (index "Index") 131 | (bufnum &optional (in 0.0) (mul 1.0) (add 0.0)) 132 | ((:ar 133 | (madd (multinew new 'pure-ugen bufnum in) mul add)) 134 | (:kr 135 | (madd (multinew new 'pure-ugen bufnum in) mul add)))) 136 | 137 | (defugen (wrap-index "WrapIndex") 138 | (bufnum &optional (in 0.0) (mul 1.0) (add 0.0)) 139 | ((:ar 140 | (madd (multinew new 'pure-ugen bufnum in) mul add)) 141 | (:kr 142 | (madd (multinew new 'pure-ugen bufnum in) mul add)))) 143 | 144 | (defugen (index-in-between "IndexInBetween") 145 | (bufnum &optional (in 0.0) (mul 1.0) (add 0.0)) 146 | ((:ar 147 | (madd (multinew new 'pure-ugen bufnum in) mul add)) 148 | (:kr 149 | (madd (multinew new 'pure-ugen bufnum in) mul add)))) 150 | 151 | (defugen (detect-index "DetectIndex") 152 | (bufnum &optional (in 0.0) (mul 1.0) (add 0.0)) 153 | ((:ar 154 | (madd (multinew new 'pure-ugen bufnum in) mul add)) 155 | (:kr 156 | (madd (multinew new 'pure-ugen bufnum in) mul add)))) 157 | 158 | (defugen (shaper "Shaper") 159 | (bufnum &optional (in 0.0) (mul 1.0) (add 0.0)) 160 | ((:ar 161 | (madd (multinew new 'pure-ugen bufnum in) mul add)) 162 | (:kr 163 | (madd (multinew new 'pure-ugen bufnum in) mul add)))) 164 | 165 | (defugen (index-l "IndexL") 166 | (bufnum &optional (in 0.0) (mul 1.0) (add 0.0)) 167 | ((:ar 168 | (madd (multinew new 'pure-ugen bufnum in) mul add)) 169 | (:kr 170 | (madd (multinew new 'pure-ugen bufnum in) mul add)))) 171 | 172 | 173 | 174 | (defugen (degree-to-key "DegreeToKey") 175 | (bufnum &optional (in 0.0) (octave 12.0) (mul 1.0) (add 0.0)) 176 | ((:ar 177 | (madd (multinew new 'pure-ugen bufnum in octave) mul add)) 178 | (:kr 179 | (madd (multinew new 'pure-ugen bufnum in octave) mul add)))) 180 | 181 | 182 | 183 | 184 | (defugen (select "Select") (which array) 185 | ((:ar (multinew-list new 'pure-ugen (cons which array))) 186 | (:kr (multinew-list new 'pure-ugen (cons which array)))) 187 | :check-fn (lambda (ugen) 188 | (when (eql (rate ugen) :audio) 189 | (loop for i from 1 below (length (inputs ugen)) 190 | do (unless (eql (rate (nth i (inputs ugen))) :audio) 191 | (error (format nil "input was not audio rate : ~a" (nth i (inputs ugen))))))))) 192 | 193 | (defugen (select-x "SelectX") (which array &optional (wrap 1.0)) 194 | ((:ar (progn 195 | new wrap 196 | (x-fade2.ar (select.ar (round~ which 2) array) 197 | (select.ar (add (trunc which 2) 1) array) 198 | (fold2 (minus (mul which 2) 1) 1)))) 199 | (:kr (progn 200 | new wrap 201 | (x-fade2.kr (select.kr (round~ which 2) array) 202 | (select.kr (add (trunc which 2) 1) array) 203 | (fold2 (minus (mul which 2) 1) 1)))))) 204 | 205 | (defugen (lin-select-x "LinSelectX") (which array &optional (wrap 1.0)) 206 | ((:ar (progn 207 | new wrap 208 | (lin-x-fade2.ar (select.ar (round~ which 2) array) 209 | (select.ar (add (trunc which 2) 1) array) 210 | (fold2 (minus (mul which 2) 1) 1)))) 211 | (:kr (progn new wrap 212 | (lin-x-fade2.kr (select.kr (round~ which 2) array) 213 | (select.kr (add (trunc which 2) 1) array) 214 | (fold2 (minus (mul which 2) 1) 1)))))) 215 | 216 | (defugen (select-x-focus "SelectXFocus") (which array &optional (focus 1.0)) 217 | ((:ar (progn new 218 | (mix (loop for input in array for i from 0 219 | collect (mul (max~ (minus 1 (mul (abs~ (minus which i)) focus)) 0) input))))) 220 | (:kr (progn new 221 | (mix (loop for input in array for i from 0 222 | collect (mul (max~ (minus 1 (mul (abs~ (minus which i)) focus)) 0) input))))))) 223 | 224 | 225 | (defugen (vibrato "Vibrato") (&optional (freq 440.0) (frate 6) (depth 0.02) (delay 0.0) (onset 0.0) 226 | (rate-variation 0.04) (depth-variation 0.1) (iphase 0.0)) 227 | ((:ar 228 | (multinew new 'pure-ugen freq frate depth delay onset rate-variation depth-variation iphase)) 229 | (:kr 230 | (multinew new 'pure-ugen freq frate depth delay onset rate-variation depth-variation iphase)))) 231 | 232 | 233 | (defugen (t-choose "TChoose") (trig array) 234 | ((:ar (progn new (select.ar (ti-rand.ar 0 (1- (length array)) trig) array))) 235 | (:kr (progn new (select.kr (ti-rand.kr 0 (1- (length array)) trig) array))))) 236 | 237 | (defugen (tw-choose "TWChoose") (trig array weights &optional (normalize 0)) 238 | ((:ar (progn new (select.ar (tw-index.ar trig weights normalize) array))) 239 | (:kr (progn new (select.kr (tw-index.kr trig weights normalize) array))))) 240 | 241 | 242 | 243 | ;; 244 | ;; from SCClassLibrary/backwards_compatibility/PMOsc.sc 245 | ;; 246 | (defun pm-osc.ar (car-freq mod-freq &optional (pm-index 0.0) (mod-phase 0.0) (mul 1.0) (add 0.0)) 247 | (sin-osc.ar car-freq (sin-osc.ar mod-freq mod-phase pm-index) mul add)) 248 | 249 | (defun pm-osc.kr (car-freq mod-freq &optional (pm-index 0.0) (mod-phase 0.0) (mul 1.0) (add 0.0)) 250 | (sin-osc.kr car-freq (sin-osc.kr mod-freq mod-phase pm-index) mul add)) 251 | 252 | (export 'pm-osc.ar) 253 | (export 'pm-osc.kr) 254 | -------------------------------------------------------------------------------- /ugens/Filter.lisp: -------------------------------------------------------------------------------- 1 | ;;; ...in Filter.sc 2 | (in-package #:sc) 3 | 4 | (defugen (resonz "Resonz") (&optional (in 0.0) (freq 440.0) (bwr 1.0) (mul 1.0) (add 0.0)) 5 | ((:ar (madd (multinew new 'pure-ugen in freq bwr) mul add)) 6 | (:kr (madd (multinew new 'pure-ugen in freq bwr) mul add))) 7 | :check-fn #'check-same-rate-as-first-input) 8 | 9 | (defugen (one-pole "OnePole") 10 | (&optional (in 0.0) (coef 0.5) (mul 1.0) (add 0.0)) 11 | ((:ar (madd (multinew new 'pure-ugen in coef) mul add)) 12 | (:kr (madd (multinew new 'pure-ugen in coef) mul add))) 13 | :check-fn #'check-same-rate-as-first-input) 14 | 15 | (defugen (one-zero "OneZero") 16 | (&optional (in 0.0) (coef 0.5) (mul 1.0) (add 0.0)) 17 | ((:ar (madd (multinew new 'pure-ugen in coef) mul add)) 18 | (:kr (madd (multinew new 'pure-ugen in coef) mul add))) 19 | :check-fn #'check-same-rate-as-first-input) 20 | 21 | (defugen (two-pole "TwoPole") 22 | (&optional (in 0.0) (freq 440.0) (radius 0.8) (mul 1.0) (add 0.0)) 23 | ((:ar (madd (multinew new 'pure-ugen in freq radius) mul add)) 24 | (:kr (madd (multinew new 'pure-ugen in freq radius) mul add))) 25 | :check-fn #'check-same-rate-as-first-input) 26 | 27 | (defugen (two-zero "TwoZero") 28 | (&optional (in 0.0) (freq 440.0) (radius 0.8) (mul 1.0) (add 0.0)) 29 | ((:ar (madd (multinew new 'pure-ugen in freq radius) mul add)) 30 | (:kr (madd (multinew new 'pure-ugen in freq radius) mul add))) 31 | :check-fn #'check-same-rate-as-first-input) 32 | 33 | (defugen (apf "APF") 34 | (&optional (in 0.0) (freq 440.0) (radius 0.8) (mul 1.0) (add 0.0)) 35 | ((:ar (madd (multinew new 'pure-ugen in freq radius) mul add)) 36 | (:kr (madd (multinew new 'pure-ugen in freq radius) mul add))) 37 | :check-fn #'check-same-rate-as-first-input) 38 | 39 | (defugen (integrator "Integrator") 40 | (&optional (in 0.0) (coef 1.0) (mul 1.0) (add 0.0)) 41 | ((:ar (madd (multinew new 'pure-ugen in coef) mul add)) 42 | (:kr (madd (multinew new 'pure-ugen in coef) mul add))) 43 | :check-fn #'check-same-rate-as-first-input) 44 | 45 | (defugen (Decay "Decay") 46 | (&optional (in 0.0) (decay-time 1.0) (mul 1.0) (add 0.0)) 47 | ((:ar (madd (multinew new 'pure-ugen in decay-time) mul add)) 48 | (:kr (madd (multinew new 'pure-ugen in decay-time) mul add))) 49 | :check-fn #'check-same-rate-as-first-input) 50 | 51 | (defugen (decay2 "Decay2") 52 | (&optional (in 0.0) (attack-time 0.01) (decay-time 1.0) (mul 1.0) (add 0.0)) 53 | ((:ar (madd (multinew new 'pure-ugen in attack-time decay-time) mul add)) 54 | (:kr (madd (multinew new 'pure-ugen in attack-time decay-time) mul add))) 55 | :check-fn #'check-same-rate-as-first-input) 56 | 57 | (defugen (lag "Lag") 58 | (&optional (in 0.0) (lag-time 0.1) (mul 1.0) (add 0.0)) 59 | ((:ar (madd (multinew new 'pure-ugen in lag-time) mul add)) 60 | (:kr (madd (multinew new 'pure-ugen in lag-time) mul add))) 61 | :check-fn #'check-same-rate-as-first-input) 62 | 63 | (defugen (lag2 "Lag2") 64 | (&optional (in 0.0) (lag-time 0.1) (mul 1.0) (add 0.0)) 65 | ((:ar (madd (multinew new 'pure-ugen in lag-time) mul add)) 66 | (:kr (madd (multinew new 'pure-ugen in lag-time) mul add))) 67 | :check-fn #'check-same-rate-as-first-input) 68 | 69 | (defugen (lag3 "Lag3") 70 | (&optional (in 0.0) (lag-time 0.1) (mul 1.0) (add 0.0)) 71 | ((:ar (madd (multinew new 'pure-ugen in lag-time) mul add)) 72 | (:kr (madd (multinew new 'pure-ugen in lag-time) mul add))) 73 | :check-fn #'check-same-rate-as-first-input) 74 | 75 | (defugen (ramp "Ramp") 76 | (&optional (in 0.0) (lag-time 0.1) (mul 1.0) (add 0.0)) 77 | ((:ar (madd (multinew new 'pure-ugen in lag-time) mul add)) 78 | (:kr (madd (multinew new 'pure-ugen in lag-time) mul add))) 79 | :check-fn #'check-same-rate-as-first-input) 80 | 81 | (defugen (lag-ud "LagUD") 82 | (&optional (in 0.0) (lag-time-u 0.1) (lag-time-d 0.1) (mul 1.0) (add 0.0)) 83 | ((:ar (madd (multinew new 'pure-ugen in lag-time-u lag-time-d) mul add)) 84 | (:kr (madd (multinew new 'pure-ugen in lag-time-u lag-time-d) mul add))) 85 | :check-fn #'check-same-rate-as-first-input) 86 | 87 | (defugen (lag-2ud "Lag2UD") 88 | (&optional (in 0.0) (lag-time-u 0.1) (lag-time-d 0.1) (mul 1.0) (add 0.0)) 89 | ((:ar (madd (multinew new 'pure-ugen in lag-time-u lag-time-d) mul add)) 90 | (:kr (madd (multinew new 'pure-ugen in lag-time-u lag-time-d) mul add))) 91 | :check-fn #'check-same-rate-as-first-input) 92 | 93 | (defugen (lag-3ud "Lag3UD") 94 | (&optional (in 0.0) (lag-time-u 0.1) (lag-time-d 0.1) (mul 1.0) (add 0.0)) 95 | ((:ar (madd (multinew new 'pure-ugen in lag-time-u lag-time-d) mul add)) 96 | (:kr (madd (multinew new 'pure-ugen in lag-time-u lag-time-d) mul add))) 97 | :check-fn #'check-same-rate-as-first-input) 98 | 99 | 100 | (defun var-lag-new (rate new in time curvature warp start) 101 | (let* ((start (if (not (eql :false start)) start in)) 102 | (curve (gethash warp +env-shape-table+)) 103 | (curvature (if curve 0 curvature)) 104 | (curve (if curve curve warp))) 105 | (if (/= curve 1) 106 | (let* ((env-arrays (make-env-array-from-env (env (list start in) (list time) warp)))) 107 | (loop for e in env-arrays 108 | do (setf (aref e 6) curve 109 | (aref e 7) curvature)) 110 | (let ((trig (if (eql rate :audio) (+~ (changed.ar in) (impulse.ar 0)) 111 | (+~ (changed.kr in) (impulse.kr 0))))) 112 | (unless (eql (rate time) :scalar) 113 | (setf trig (+~ trig (changed.kr time)))) 114 | (if (eql rate :audio) (env-gen.ar env-arrays :gate trig) 115 | (env-gen.kr env-arrays :gate trig)))) 116 | (funcall new 'pure-ugen in time start)))) 117 | 118 | (defugen (var-lag "VarLag") 119 | (&optional (in 0.0) (time .1) (curvature 0) (warp 5) start (mul 1.0) (add 0.0)) 120 | ((:ar (madd (multinew #'var-lag-new :audio new in time curvature warp (if start start :false)) mul add)) 121 | (:kr (madd (multinew #'var-lag-new :control new in time curvature warp (if start start :false)) mul add))) 122 | :check-fn #'check-same-rate-as-first-input) 123 | 124 | 125 | 126 | (defugen (leak-dc "LeakDC") 127 | (&optional (in 0.0) (coef 0.995) (mul 1.0) (add 0.0)) 128 | ((:ar (madd (multinew new 'pure-ugen in coef) mul add)) 129 | (:kr (madd (multinew new 'pure-ugen in coef) mul add))) 130 | :check-fn #'check-same-rate-as-first-input) 131 | 132 | (defugen (rlpf "RLPF") 133 | (&optional (in 0.0) (freq 440.0) (rq 1.0) (mul 1.0) (add 0.0)) 134 | ((:ar (madd (multinew new 'pure-ugen in freq rq) mul add)) 135 | (:kr (madd (multinew new 'pure-ugen in freq rq) mul add))) 136 | :check-fn #'check-same-rate-as-first-input) 137 | 138 | (defugen (rhpf "RHPF") 139 | (&optional (in 0.0) (freq 440.0) (rq 1.0) (mul 1.0) (add 0.0)) 140 | ((:ar (madd (multinew new 'pure-ugen in freq rq) mul add)) 141 | (:kr (madd (multinew new 'pure-ugen in freq rq) mul add))) 142 | :check-fn #'check-same-rate-as-first-input) 143 | 144 | (defugen (lpf "LPF") 145 | (&optional (in 0.0) (freq 440.0) (mul 1.0) (add 0.0)) 146 | ((:ar (madd (multinew new 'pure-ugen in freq) mul add)) 147 | (:kr (madd (multinew new 'pure-ugen in freq) mul add))) 148 | :check-fn #'check-same-rate-as-first-input) 149 | 150 | (defugen (hpf "HPF") 151 | (&optional (in 0.0) (freq 440.0) (mul 1.0) (add 0.0)) 152 | ((:ar (madd (multinew new 'pure-ugen in freq) mul add)) 153 | (:kr (madd (multinew new 'pure-ugen in freq) mul add))) 154 | :check-fn #'check-same-rate-as-first-input) 155 | 156 | (defugen (bpf "BPF") 157 | (&optional (in 0.0) (freq 440.0) (rq 1.0) (mul 1.0) (add 0.0)) 158 | ((:ar (madd (multinew new 'pure-ugen in freq rq) mul add)) 159 | (:kr (madd (multinew new 'pure-ugen in freq rq) mul add))) 160 | :check-fn #'check-same-rate-as-first-input) 161 | 162 | (defugen (brf "BRF") 163 | (&optional (in 0.0) (freq 440.0) (rq 1.0) (mul 1.0) (add 0.0)) 164 | ((:ar (madd (multinew new 'pure-ugen in freq rq) mul add)) 165 | (:kr (madd (multinew new 'pure-ugen in freq rq) mul add))) 166 | :check-fn #'check-same-rate-as-first-input) 167 | 168 | (defugen (mid-eq "MidEQ") 169 | (&optional (in 0.0) (freq 440.0) (rq 1.0) (db 0.0) (mul 1.0) (add 0.0)) 170 | ((:ar (madd (multinew new 'pure-ugen in freq rq db) mul add)) 171 | (:kr (madd (multinew new 'pure-ugen in freq rq db) mul add))) 172 | :check-fn #'check-same-rate-as-first-input) 173 | 174 | (defugen (lpz-1 "LPZ1") 175 | (&optional (in 0.0) (mul 1.0) (add 0.0)) 176 | ((:ar (madd (multinew new 'pure-ugen in) mul add)) 177 | (:kr (madd (multinew new 'pure-ugen in) mul add))) 178 | :check-fn #'check-same-rate-as-first-input) 179 | 180 | (defugen (hpz-1 "HPZ1") 181 | (&optional (in 0.0) (mul 1.0) (add 0.0)) 182 | ((:ar (madd (multinew new 'pure-ugen in) mul add)) 183 | (:kr (madd (multinew new 'pure-ugen in) mul add))) 184 | :check-fn #'check-same-rate-as-first-input) 185 | 186 | (defugen (slope "Slope") 187 | (&optional (in 0.0) (mul 1.0) (add 0.0)) 188 | ((:ar (madd (multinew new 'pure-ugen in) mul add)) 189 | (:kr (madd (multinew new 'pure-ugen in) mul add))) 190 | :check-fn #'check-same-rate-as-first-input) 191 | 192 | 193 | (defugen (changed "Changed") 194 | (&optional (in 0.0) (threshold 0.0)) 195 | ((:ar (progn new (>~ (abs~ (hpz-1.ar in)) threshold))) 196 | (:kr (progn new (>~ (abs~ (hpz-1.kr in)) threshold)))) 197 | :check-fn #'check-same-rate-as-first-input) 198 | 199 | 200 | (defugen (lpz-2 "LPZ2") 201 | (&optional (in 0.0) (mul 1.0) (add 0.0)) 202 | ((:ar (madd (multinew new 'pure-ugen in) mul add)) 203 | (:kr (madd (multinew new 'pure-ugen in) mul add))) 204 | :check-fn #'check-same-rate-as-first-input) 205 | 206 | (defugen (hpz-2 "HPZ2") 207 | (&optional (in 0.0) (mul 1.0) (add 0.0)) 208 | ((:ar (madd (multinew new 'pure-ugen in) mul add)) 209 | (:kr (madd (multinew new 'pure-ugen in) mul add))) 210 | :check-fn #'check-same-rate-as-first-input) 211 | 212 | (defugen (bpz-2 "BPZ2") 213 | (&optional (in 0.0) (mul 1.0) (add 0.0)) 214 | ((:ar (madd (multinew new 'pure-ugen in) mul add)) 215 | (:kr (madd (multinew new 'pure-ugen in) mul add))) 216 | :check-fn #'check-same-rate-as-first-input) 217 | 218 | (defugen (brz-2 "BRZ2") 219 | (&optional (in 0.0) (mul 1.0) (add 0.0)) 220 | ((:ar (madd (multinew new 'pure-ugen in) mul add)) 221 | (:kr (madd (multinew new 'pure-ugen in) mul add))) 222 | :check-fn #'check-same-rate-as-first-input) 223 | 224 | (defugen (median "Median") 225 | (&optional (length 3) (in 0.0) (mul 1.0) (add 0.0)) 226 | ((:ar (madd (multinew new 'pure-ugen length in) mul add)) 227 | (:kr (madd (multinew new 'pure-ugen length in) mul add))) 228 | :check-fn #'check-when-audio) 229 | 230 | (defugen (slew "Slew") 231 | (&optional (in 0.0) (up 1.0) (dn 1.0) (mul 1.0) (add 0.0)) 232 | ((:ar (madd (multinew new 'pure-ugen in up dn) mul add)) 233 | (:kr (madd (multinew new 'pure-ugen in up dn) mul add))) 234 | :check-fn #'check-same-rate-as-first-input) 235 | 236 | (defugen (fos "FOS") 237 | (&optional (in 0.0) (a0 0.0) (a1 0.0) (b1 0.0) (mul 1.0) (add 0.0)) 238 | ((:ar (madd (multinew new 'pure-ugen in a0 a1 b1) mul add)) 239 | (:kr (madd (multinew new 'pure-ugen in a0 a1 b1) mul add))) 240 | :check-fn #'check-same-rate-as-first-input) 241 | 242 | (defugen (sos "SOS") 243 | (&optional (in 0.0) (a0 0.0) (a1 0.0) (a2 0.0) (b1 0.0) (b2 0.0) (mul 1.0) (add 0.0)) 244 | ((:ar (madd (multinew new 'pure-ugen in a0 a1 a2 b1 b2) mul add)) 245 | (:kr (madd (multinew new 'pure-ugen in a0 a1 a2 b1 b2) mul add))) 246 | :check-fn #'check-same-rate-as-first-input) 247 | 248 | 249 | (defugen (ringz "Ringz") 250 | (&optional (in 0.0) (freq 440.0) (decay-time 1.0) (mul 1.0) (add 0.0)) 251 | ((:ar (madd (multinew new 'pure-ugen in freq decay-time) mul add)) 252 | (:kr (madd (multinew new 'pure-ugen in freq decay-time) mul add))) 253 | :check-fn #'check-same-rate-as-first-input) 254 | 255 | 256 | (defugen (formlet "Formlet") 257 | (&optional (in 0.0) (freq 440.0) (attack 1.0) (decay 1.0) (mul 1.0) (add 0.0)) 258 | ((:ar (madd (multinew new 'pure-ugen in freq attack decay) mul add)) 259 | (:kr (madd (multinew new 'pure-ugen in freq attack decay) mul add))) 260 | :check-fn #'check-same-rate-as-first-input) 261 | 262 | 263 | (defugen (detect-silence "DetectSilence") 264 | (&optional (in 0.0) (amp 0.0001) &key (time 0.1) (act :no-action)) 265 | ((:ar (multinew new 'ugen in amp time (act act))) 266 | (:kr (multinew new 'ugen in amp time (act act)))) 267 | :check-fn #'check-same-rate-as-first-input) 268 | 269 | 270 | 271 | --------------------------------------------------------------------------------