117 lines
4.2 KiB
Common Lisp
117 lines
4.2 KiB
Common Lisp
;nyquist plug-in
|
|
;version 4
|
|
;type generate
|
|
;name "Random Piecewise Linear..."
|
|
;action "Generating..."
|
|
;author "dm"
|
|
;copyright "Released under terms of the GNU General Public License version 2"
|
|
;release 1.1
|
|
|
|
;control duration "Duration" time "" 3 0 nil
|
|
;control fund-freq "Frequency (Hz)" float "" 50 1 300
|
|
;control locks "Parameter Lock (Table Duration)" string "" "(5 3.5) (7 1.1)"
|
|
;control text "Timbral Parameters:"
|
|
;control seed "Random Seed" int "" 12532 1 134455
|
|
;control num-tables "Number of Key Tables" int "" 5 1 50
|
|
;control num-breakpoints "Max. Segments Per Key Table" int "" 5 1 15
|
|
;control vary-breakpoints "Vary Segments Per Key Table" choice "No,Yes" 0
|
|
;control table-type "Table In" choice "Sine,Saw,Fifth,Triangle,Random" 0
|
|
|
|
(defun rnd ()
|
|
;;;pseudorandom number between -1 and 1
|
|
(setq seed (rem (sum (mult 8121 seed) 28411) 134456))
|
|
(- (/ (float seed) 134456 0.5) 1))
|
|
|
|
;;;GENERATE LIST OF WAVETABLES AND BREAKPOINTS FOR SIOSC
|
|
|
|
(defun build-shaper (num-breaks)
|
|
;;;pseudorandom piecewise linear function on [0,2] with num-breaks pieces
|
|
(if (zerop num-breaks)
|
|
(pwlv -1 2.01 1)
|
|
(do* ((i 1 (+ i 1))
|
|
(new-time 0 (sum (rnd) 1 new-time))
|
|
(point-list (list (rnd)) (cons (rnd) (cons new-time point-list))))
|
|
((> i num-breaks)
|
|
(stretch-abs (/ 2.01 new-time) (pwlv-list (reverse point-list)))))))
|
|
|
|
(defun get-num-breaks (max-breaks)
|
|
;;;decide how many breakpoints build-shaper should create
|
|
(case vary-breakpoints
|
|
(0 max-breaks)
|
|
(1 (truncate (* max-breaks (+ 1 (rnd)))))))
|
|
|
|
(defun gen-table (raw-table max-breaks)
|
|
(shape raw-table (build-shaper (get-num-breaks max-breaks)) 1))
|
|
|
|
(defun get-raw-table ()
|
|
;;;decide which raw table to use
|
|
(case table-type
|
|
(0 (build-harmonic 1 2048))
|
|
(1 (pwlv -1 1 1))
|
|
(2 (scale 0.49 (sum (build-harmonic 2 2048) (build-harmonic 3 2048))))
|
|
(3 (pwlv -1 1 1 2 -1))
|
|
(4 (scale 0.49 (build-shaper num-breakpoints)))))
|
|
|
|
(defun wav-list (duration num-tables breaks-per-table slock-list)
|
|
(if (= num-tables 1)
|
|
(let ((cur-table (gen-table (get-raw-table) breaks-per-table)))
|
|
(list cur-table duration cur-table))
|
|
(let ((interval (/ duration num-tables))
|
|
(raw-table (get-raw-table)))
|
|
(do* ((ind 1 (+ 1 ind))
|
|
(cur-time interval (sum interval cur-time))
|
|
(cur-table (gen-table raw-table breaks-per-table)
|
|
(gen-table raw-table breaks-per-table))
|
|
(breakpoints-list (list cur-table)
|
|
(cons cur-table (cons cur-time breakpoints-list))))
|
|
((= ind num-tables) (reverse breakpoints-list))
|
|
;;locks: continue to use current wavetable for specified time
|
|
(if (and slock-list (= ind (caar slock-list)))
|
|
(progn
|
|
(setf cur-time (sum (cadar slock-list) cur-time))
|
|
(setf breakpoints-list (cons cur-table (cons cur-time breakpoints-list)))
|
|
(setf slock-list (cdr slock-list))))))))
|
|
|
|
;;;VALIDATE AND PROCESS USER INPUT
|
|
|
|
(defun sort-by-car (lst)
|
|
(sort lst
|
|
(lambda (x y) (< (car x) (car y)))))
|
|
|
|
(defun validate-pairs (pair)
|
|
(if (and (listp pair) (= 2 (length pair)))
|
|
(if (and (integerp (car pair))
|
|
(> (car pair) 0)
|
|
(<= (car pair) num-tables))
|
|
(if (and (numberp (cadr pair)) (plusp (cadr pair)))
|
|
pair
|
|
(throw 'err
|
|
(format nil "Lock duration ~s not a positive number."
|
|
(cadr pair))))
|
|
(throw 'err (format nil
|
|
"Lock table ~s not between 1 and ~s inclusive." (car pair) num-tables)))
|
|
(throw 'err (format nil
|
|
"Lock ~s not a pair of the form (Table Duration)." pair))))
|
|
|
|
;;;When 2.3.1 is out, replace with eval-string
|
|
(defun string-to-list (string)
|
|
(read (make-string-input-stream (format nil "(~a)" string))))
|
|
|
|
(defun process-locks (str)
|
|
(sort-by-car (mapcar #'validate-pairs (string-to-list str))))
|
|
|
|
;;;PROCESS OUTPUT
|
|
|
|
(defun pch-mod (dur)
|
|
;;placeholder
|
|
(s-rest dur))
|
|
|
|
(defun normalize (sig)
|
|
(let ((ac (highpass8 sig 25)))
|
|
(scale (/ 0.95 (peak ac ny:all)) ac)))
|
|
|
|
;;;main
|
|
(catch 'err (normalize (siosc
|
|
(hz-to-step fund-freq)
|
|
(pch-mod duration)
|
|
(wav-list duration num-tables num-breakpoints (process-locks locks))))) |