LISP code for the concrete instrument
from/for Christopher Bailey's Dissertation
LISP code for the concrete instrument
;
; FOR CONCRETE SOUNDS:
;
; Parameters are:
;
; start: msr beat div
;
; ((parameter (spec lists) (parameter (spec-lists)) etc.)
;
;
; amp-multiplier from 0-5 (3 signifying a 1.0 multiplier)
;
; Spatialization stereo-pos
;
; start-at-a-bang OR cutoff-pre-bang garbage?---> cut OR full
; IF you're going to use a bang-tree, probably use "full"
;
;
; amplitude makegen curve (if empty list, then curve of all 1's)
;
; DATA needed at the end:
;
; exact loud/hardness, concrete-soundnumber,
; 0-5
;
; output-soundfile-name, supply exact duration, re-write flag
; in seconds
;
;
; (conc 0 0 0
; ((5 ((2 4))) (arb (bla bla bla bla))
; 3 0 cut 3 (0,0, 1,1, 2,.3, 4,.7, 5,0) )
; (conc 0 0 0
; ((6 ((2 4))) (3 ((4 6))))
; 3 0 cut 3 () 3 124 "1.0002.aiff" 0.436 0)
;
;
; instr msr beat div par-list amp-fac spat? stereo cut/full makegen-curve loud/hard/amp |||conc-sound# filename dur re-write?
; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14
;
;
;
(defun make-conc (note-number)
; do error checking for everything, print message and exit if found
;
(labels
((initialize-note-in-note-list (note-number)
(let ((nll ())
(file-str ()))
(setf nll (length (nth note-number note-list)))
(case nll
; append concrete-soundnumber, filename, duration, re-write flag
('11
; concrete-soundnumber placeholder
(setf (nth note-number note-list)
(append (nth note-number note-list)
(list '0)))
; filename
(setf file-str (princ-to-string (+ note-number (const-frandom 0.0 1.0))))
(setf (nth note-number note-list)
(append (nth note-number note-list)
(list (concatenate 'string file-str ".aiff"))))
; duration
(setf (nth note-number note-list)
(append (nth note-number note-list)
(list '0.0)))
; re-write flag
(setf (nth note-number note-list)
(append (nth note-number note-list)
(list '0))))
; change re-write flag
('15
(setf (nth conc-rewrite-par (nth note-number note-list)) '0)
(shell (concatenate 'string "rm " (nth conc-file-par (nth note-number note-list))))
(setf file-str (subseq
(nth conc-file-par (nth note-number note-list))
0
(- (length (nth conc-file-par (nth note-number note-list)))
5)))))
file-str)))
;
;
;
(let
((concrete-soundnumber ())
(file-str ())
(score-filename ())
(dur '0.0)
(amp '0.0)
(inskip '0.0)
(stereo-pos '0.0)
(makegen-command ())
(makegen-string ())
(spat-command ())
(extra-time '0.0)
(final-dur '0.0)
)
;
(setf file-str (initialize-note-in-note-list note-number))
; select the sound first
(setf concrete-soundnumber (get-a-sound note-number))
(setf score-filename (concatenate 'string file-str ".sco"))
(setf dur (- (aref sounds concrete-soundnumber '1) .0015))
(setf amp (nth conc-amp-par (nth note-number note-list)))
(setf stereo-pos (/ (nth conc-stereo-par (nth note-number note-list)) 5.0))
;
; setf inskip and dur based on cut/full command in note-list
(if (aref sounds concrete-soundnumber '6)
; unless there is no bangs list, in which case inskip is always 0.0
(case (nth conc-attq-par (nth note-number note-list))
('cut (setf inskip
(getel (aref sounds concrete-soundnumber '6) ))
(setf dur (- dur inskip)))
('full () )
; keep default values
(otherwise (format t "bogus cut/full type in note-number ~a ~%"
(nth conc-file-par (nth note-number note-list))) (bye))))
;
;
; make makegen command
; include a tapering of 6-7 ms at the end
(case (length (nth conc-makegen-curve-par (nth note-number note-list)))
('0 (setf makegen-command
(concatenate 'string "makegen(1, 24, 2000, 0, 1,"
(princ-to-string (- (* dur 1000.0) (const-frandom 5.0 7.0)))
", 1,"
(princ-to-string (* dur 1000.0)) ", 0)")))
(otherwise
(dolist (elo (nth conc-makegen-curve-par (nth note-number note-list)))
(setf makegen-string
(concatenate 'string makegen-string
(princ-to-string elo) ", ")))
(setf makegen-command
(concatenate 'string "makegen(1, 24, 2000, "
makegen-string
;
; mandatory tapering off
; the new last time element of the makegen is:
; last-time-element-from-the-string +
; last-time-element *
; the percentage that 10-20 ms is of dur
;
(princ-to-string
(+ (first (last (nth conc-makegen-curve-par (nth note-number note-list)) 2))
(* (/ (const-frandom .01 .02) dur)
(first (last (nth conc-makegen-curve-par (nth note-number note-list)) 2)))))
", 0)"))))
;
;
;
;
; check for spatialization
(case (nth conc-spatq-par (nth note-number note-list))
;
('0
; no spatialization, write a STEREO output file wth correct position
(with-open-file (score-file score-filename :direction :output)
;
;
;
;
; set-up stuff in score
(format score-file
"~% rtsetparams(44100, 2) ~%~%
load(\"STEREO\") ~%
rtoutput(\"~a\") ~%
reset(44100) ~%
input(\"~a\", 1) ~%
ch=chans(1) ~%~%
rtinput(\"~a\") ~%~%
~a ~%~%
if (ch==1) ~%
{
STEREO(0, ~a, ~a, ~a, ~a) ~%
} ~%
if (ch==2)
{
STEREO(0, ~a, ~a, ~a, ~a, ~a) ~%
} ~%
~%~%"
(concatenate 'string file-str ".aiff")
; for "input()" in score (dead-time input command used to find out
; the number of channels in the soundfile, so we can deal with the stereo
; position issue properly.
(concatenate 'string concrete-sounds-directory (aref sounds concrete-soundnumber '0))
; for the "rtinput()" in score
(concatenate 'string concrete-sounds-directory (aref sounds concrete-soundnumber '0))
; makegen
makegen-command
; if it's a mono input file. Straightforward.
inskip dur
; set amp to correct for stereo loss
(case (nth conc-stereo-par (nth note-number note-list))
(0 1.0) (1 1.4) (2 1.8) (3 1.8) (4 1.4) (5 1.0))
stereo-pos
;
; if it's a stereo file. less straightforward
inskip dur
; set amp to correct for stereo loss
(* amp
(case (nth conc-stereo-par (nth note-number note-list))
(0 0.6) (1 0.75) (2 .97) (3 .97) (4 0.75) (5 0.6)))
; weird-asss stereo-positioning for a stereo input file
; where to put left channel
(case (nth conc-stereo-par (nth note-number note-list))
(0 0.0) (1 0.0) (2 0.0) (3 0.2) (4 0.4) (5 0.6) )
; where to put right channel
(case (nth conc-stereo-par (nth note-number note-list))
(0 0.4) (1 0.6) (2 0.8) (3 1.0) (4 1.0) (5 1.0) )))
;
;
; run score
(shell (concatenate 'string "CMIX < " score-filename))
; erase score file
(shell (concatenate 'string "rm " score-filename)))
;
;
; yes spatialization
;
;
('1
(with-open-file (score-file score-filename :direction :output)
;
;
; if input sound is mono, use MIX, write out a mono file with makegen
; if input sound is stereo, use MIX, write out a stereo file, adjust amp
;
; set-up stuff in score
(format score-file
"~% rtsetparams(44100, 1) ~%
rtoutput(\"~a\") ~%
reset(44100) ~%
input(\"~a\", 1) ~%
ch=chans(1) ~%~%
rtinput(\"~a\") ~%~%
~a
if (ch==1) ~%
{
MIX(0, ~a, ~a, ~a, 0) ~%
} ~%
if (ch==2)
{
MIX(0, ~a, ~a, ~a, 0, 0) ~%
} ~%
~%~%"
(concatenate 'string file-str ".aiff")
; for "input()" in score (dead-time input command used to find out
; the number of channels in the soundfile, so we can deal with the stereo
; position issue properly.
(concatenate 'string concrete-sounds-directory (aref sounds concrete-soundnumber '0))
; for the "rtinput()" in score
(concatenate 'string concrete-sounds-directory (aref sounds concrete-soundnumber '0))
; makegen
makegen-command
; if it's a mono file:
inskip dur amp
; if it's a stereo file:
inskip dur
; set amp to correct for stereo loss
(* amp 0.75)))
;
;
; run score
;
;
(shell (concatenate 'string "CMIX < " score-filename))
; erase score file
(shell (concatenate 'string "rm " score-filename))
;
(setf spat-command (concatenate 'string "freeverbit "
file-str ".aiff "
; roomsize:
(princ-to-string (const-frandom .4 .7)) " "
; damp:
"0.3 "
; wet:
(princ-to-string (const-frandom .3 .5)) " "
; dry:
(princ-to-string (const-frandom .6 .7)) " "
; width:
"3 "
; gain:
".65 "
; extra-time:
(princ-to-string (setf extra-time '0.9))
" dn "
; stereo position:
(princ-to-string (- 1.0 stereo-pos))))
(print spat-command)
(shell spat-command)
; move the rev'd file to the .aiff file
(shell (concatenate 'string "mv "
file-str "_reverbed.aiff " file-str ".aiff")))
;
;
;
(otherwise (format t "bogus spat-or-not indicator in note number ~a" file-str) (bye)))
;
(setf final-dur (+ dur extra-time))
(setf (nth conc-soundnumber-par (nth note-number note-list))
concrete-soundnumber)
(setf (nth conc-dur-par (nth note-number note-list))
final-dur)
)))
;*********************************************************************************
;*********************************************************************************
;*********************************************************************************
; FUNCTIONS FOR THE PURPOSE OF GETTING A SPECIFIED SOUND
;*********************************************************************************
;*********************************************************************************
;*********************************************************************************
(defun everyone (array)
(let ((output ()))
(dotimes (count (array-dimension array 0))
(setf output (cons count output)))
output))
(defun filter-sounds (arr parameter-number test-function)
(let ((indices ())
(the-thang-to-test ()))
(dotimes (ct (array-dimension arr 0) indices)
(setf the-thang-to-test (aref arr ct parameter-number))
(if (listp the-thang-to-test)
(dolist (elle (aref arr ct parameter-number))
(if (funcall test-function elle)
(setf indices (cons ct indices))))
(if (funcall test-function the-thang-to-test)
(setf indices (cons ct indices)))))))
;
; old version, used for arbitrary test-functions. Simple
; runs a test function on the given parameter of every sound.
;
(defun simple-filter-sounds (arr parameter-number test-function)
(let ((indices ())
(the-thang-to-test ()))
(dotimes (ct (array-dimension arr 0) indices)
(setf the-thang-to-test (aref arr ct parameter-number))
(if (funcall test-function the-thang-to-test)
(setf indices (cons ct indices))))))
; given a sound-array, a parameter #, and a range
; it will return a list of sounds in that range for that parameter
(defun get-sounds-in-range (arr parameter rangelist)
(let ((result ()))
(defun range-test-func (input)
(and (>= input (first rangelist))
(<= input (second rangelist))))
(setf result (filter-sounds arr parameter #'range-test-func))))
; given a sound-array, a parameter #, and a value
; it will return a list of sounds with that value
;
(defun get-sounds-single-num-or-word (arr parameter value)
(let ((result ()))
(defun value-test-func (input)
(equal input value))
(setf result (filter-sounds arr parameter #'value-test-func))))
; this gets a list of sounds that satisfy the requirements of
; one cell in our gestural definition "spreadsheet"
;
(defun get-parameter-list-of-sounds (arr parameter list-for-given-parameter)
;
; list for given parameter is a list of zero or more lists,
; each, a range or single value, from the gesture-spreadsheet
;
(if (null list-for-given-parameter)
(everyone arr)
; null list returns all sounds as possible
(progn
(let ((list-of-sounds ()))
(dolist (elle list-for-given-parameter list-of-sounds)
; elle is thus a list of either a range, or a single value
(setf list-of-sounds
(union list-of-sounds
(if (= 1 (length elle))
(get-sounds-single-num-or-word arr parameter (first elle))
(get-sounds-in-range arr parameter elle)))))))))
;
; this gets a list of sounds that satisfy the requirements of a "bang" parameter
; in this case, the requirements are a "number" or range of "numbers", that
; specifies how many "bangs" should be found in the chosen sounds.
;
;
(defun get-bang-parameter-list-of-sounds (snd-array list-for-bang-parameter)
(if (null list-for-bang-parameter)
(everyone arr)
;
; null list means any sound is possible
;
(let ((list-of-sounds ()))
(dolist (elle list-for-bang-parameter list-of-sounds)
;
; elle is a list of either a range, or a single value
;
(setf list-of-sounds
(union list-of-sounds
(if (= 1 (length elle))
(get-sounds-with-single-num-of-elmnts snd-array 6 (first elle))
(get-sounds-with-range-num-of-elmnts snd-array 6 elle))))))))
;
;
(defun get-sounds-with-single-num-of-elmnts (snds-array parameter number)
(let ((result ()))
(defun number-test-func (input)
(= (length input) number))
(setf result (simple-filter-sounds snds-array parameter #'number-test-func))))
;
;
;
;
(defun get-sounds-with-range-num-of-elmnts (snds-array parameter range-list)
(let ((result ()))
(defun range-test-func (input)
(and (<= (length input) (first (last range-list)))
(>= (length input) (first range-list))))
(setf result (simple-filter-sounds snds-array parameter #'range-test-func))))
;
;
;
;*******************************
;******************************
; MAIN FUNCTION THAT GETS A SOUND
;*******************************
;*******************************
;
; note: this get-a-sound is different from the original in conceng.exp.lisp
;
;
(defun get-a-sound (note-number)
; intersection all the parameter-lists-of-sounds together,
; out of that list choose a random sound
(let ((final-list (everyone sounds)))
;
; go through the list of parameters
;
(dolist (elle (nth conc-list-par (nth note-number note-list)))
(case (first elle)
; case of soundnumber request
('snum (setf final-list (rest elle)))
; case of arbitrary test-function
;
('arb
(setf final-list
(intersection final-list
(funcall (rest elle)))))
;
; case of regular, non-bang parameter
((0 1 2 3 4 5 7 8 9 10 11)
(setf final-list
(intersection final-list
(get-parameter-list-of-sounds sounds
(first elle) (second elle)))))
;
; case of bang parameter
;
('6
(setf final-list
(intersection final-list
(get-bang-parameter-list-of-sounds sounds (second elle)))))))
;
; test to see what list is coming out
(format t "~%~a~%" final-list)
;
(if (null final-list)
(progn (format t "no sound exists to satisfy the parameters of note # ~a ~%~%"
(nth conc-file-par (nth note-number note-list))) (bye))
(getel (reorder final-list)))))