;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; File: multi-loops ;;; ;;; Version: 1.0 ;;; ;;; Project: loop algorithms for Non-Real Time Systems ;;; ;;; Purpose: Attempts to show a more interesting use of loops as well ;;; as an unpredictable though formally repeatable sequence of ;;; events. Looping starts at various user-defined points in ;;; a sound file; the algorithm moves gradually from one ;;; point to another by 'folding in' the next loop according ;;; to a fibonacci-based transition structure. We loop for ;;; the duration of a beat in a user-specified tempo but we ;;; occasionally throw in 'maverick' loops that are 1/2 or ;;; 1/4 of a beat. ;;; ;;; Author: Michael Edwards: m@michael-edwards.org ;;; ;;; Creation date: 25th January 2010 ;;; ;;; $$ Last modified: 21:28:47 Tue Sep 21 2010 BST ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; We introduce the concept of 'maverick' (unpredictable) rhythms: instead of ;;; just playing one-beat loops, we occasionally throw in 1/2 or 1/4 beat ;;; loops. The frequency of these can be expressed in a list ( in ;;; the structure below. This list can have as many elements we need and will ;;; be repeated circularly ad infinitum. We need a custom data type or ;;; structure to hold the data that can accomplish this, hence defstruct, as ;;; well as a function (below) that will tell us if we're on a 'maverick' event ;;; or not. ;;; ;;; is the length of the intervals list (so we only calculate this ;;; once) ;;; is the count of how many times we've triggered a 'maverick' ;;; is our internal counter of how many times we've queried our ;;; maverick ;;; is our internal record of which count number will trigger the next ;;; maverick. (defstruct maverick intervals length triggered count next) ;;; Returns a maverick instance with data initialised from the intervals at ;;; which the mavericks should occur. ;;; is a list of integers; it's the only required data as the rest ;;; are initialised when this is passed. (defun init-maverick (intervals) (make-maverick :intervals intervals :length (length intervals) :triggered 0 :count -1 ;; is the next count at which we'll trigger a maverick :next (1- (first intervals)))) ;;; Return t or nil depending on whether this event count triggers a 'maverick' ;;; or not. ;;; is the current event count so that we can find out whether to throw ;;; a maverick or not ;;; E.g.: ;;; (loop with m = (init-maverick '(8 4)) for i below 30 ;;; collect (do-maverick i m)) --> ;;; (NIL NIL NIL NIL NIL NIL NIL T NIL NIL NIL T NIL NIL NIL NIL NIL NIL NIL ;;; T NIL NIL NIL T NIL NIL NIL NIL NIL NIL) (defun do-maverick (maverick) (incf (maverick-count maverick)) ;; hence count inits to -1 (if (= (maverick-count maverick) (maverick-next maverick)) (progn ;; update the next occurrence (setf (maverick-next maverick) ;; we keep track of how many mavericks we've triggered; use ;; this here to make sure we loop through the intervals list ;; continuously (using mod to create legal list references). (+ (maverick-count maverick) (nth (mod (incf (maverick-triggered maverick)) (maverick-length maverick)) (maverick-intervals maverick)))) t) nil)) ;;; are the times (in seconds) at where we should start our loop ;;; in (defun multi-loops (entry-points input-sndfile tempo &key (output "multi-loops.wav") (srate 44100) (channels 2) ;; we're generally looping over a beat's duration but every ;; so often we'll do a half or quarter beat loop. These ;; lists specify the frequency of such (so e.g. every 21 ;; then every 13 then every 21 again etc.). They're ;; independent of each other (half-beat-mavericks '(13 8)) (quarter-beat-mavericks '(34 21)) ;; 2-element list of the minimum and maximum panning degrees (stereo-max '(20 70)) ;; use this to control transposition of the individual ;; segments (NB this is not placed over _one_ segment, ;; rather it's used for calculation of individual srts) (srt-env '(0 1 100 1)) (srt-env-base 1.5) (srt-width 20) ;; we swap gradually from the first entry-point to the ;; next. We use a fibonacci algorithm to do this, the ;; length of which will determine how quickly the ;; transition will take place NB this doesn't have to be a ;; fibonacci number by any means (transition-length 34)) (unless (and (listp stereo-max) (= 2 (length stereo-max)) (numberp (first stereo-max)) (numberp (second stereo-max)) (< (first stereo-max) (second stereo-max))) (error "multi-loops: stereo-max must be min/max panning values (0-90)")) ;; call the function that does all the actual work (let* ((loop-data (multi-loops-aux entry-points tempo half-beat-mavericks quarter-beat-mavericks transition-length)) (num-segs (length loop-data)) (stereo-range (float (- (second stereo-max) (first stereo-max)))) (srenv (clm::make-env :envelope srt-env :base srt-env-base :length num-segs)) (stereo-min (first stereo-max)) (time 0.0)) (with-sound (:output output :srate srate :channels channels) ;; the loop data generated by the aux function is a list of 2-element ;; lists: input-file start time and duration (loop for ld in loop-data for start = (first ld) for dur = (second ld) do (samp1 input-sndfile time :duration dur ;; place segment randomly in stereo space :degree (+ stereo-min (random stereo-range)) :start start :srt (clm::env srenv) :width srt-width :amp-env '(0 0 3 1 97 1 100 0)) (incf time dur))))) ;;; This auxiliary function does the actual work. (defun multi-loops-aux (entry-points tempo half-beat-mavericks quarter-beat-mavericks transition-length) ;; is a list of 1s and 0s that indicate the transition from one ;; entry to point to another (let* ((fibtrans (fibonacci-transition transition-length)) ;; our maverick rhythms (hbm (init-maverick half-beat-mavericks)) (qbm (init-maverick quarter-beat-mavericks)) (beat-dur (/ 60.0 tempo)) (half-dur (/ beat-dur 2)) (quarter-dur (/ beat-dur 4))) ;; We pick out the entry points in pairs 1,2->2,3->3,4... ;; this double loop appends one two-element list after the other, each ;; being the input file start time and the duration (loop for ep1 in entry-points and ep2 in (rest entry-points) with eplast = -1 with mavdur appending ;; so we'll always have loops with this pair (loop for ep in fibtrans ;; always 1 or 0 ;; find out whether this event is a maverick for hm = (do-maverick hbm) for qm = (do-maverick qbm) do ;; only change duration back to a full beat if we've changed entry ;; point i.e. hold the maverick duration until the next loop--we'll ;; get a sequence of 1/2 or 1/4 beat rhythms then. (unless (= ep eplast) (setf mavdur nil)) (setf mavdur (cond (qm quarter-dur) ;; so if qm and hm coincide we preference qm (as ;; it's probably rarer) (hm half-dur)) ;; nil if neither true ;; hang onto our last entry-point for comparison next time ;; through eplast ep) ;; so a 0 in our fibonacci-transition indicates the first entry ;; point, a 1 the second collect (list (if (zerop ep) ep1 ep2) ;; mavdur will be nil only if we just changed entry ;; point and we are not on a maverick event. (if mavdur mavdur beat-dur)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; #| Some tests. (multi-loops '(0 .506 .782 1.217 1.459 1.697) "feelin.beg.wav" 300) ;; This moves from structure to synthesis (multi-loops '(0 .506 .782 1.217 1.459 1.697) "feelin.beg.wav" 1000 :output "multi-loops2.wav" :transition-length 130) |# ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Helper functions. Don't worry if you don't understand these completely, ;;; just feel free to use them. ;;; fibonacci-transition-aux1 gradually decreases item1 and increases item2, ;;; this does the same but continues to increase item2 until it completely ;;; dominates e.g. ;;; (fibonacci-transition 35 0 1) -> ;;; (0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 1 0 1 0 1 0 1 0 1 0 1 0 1 1 0 1 1 1 1 1) (defun fibonacci-transition (num-items &optional (item1 0) (item2 1)) ;; just some sanity checks (unless item1 (setf item1 0)) (unless item2 (setf item2 1)) ;; we use the aux1 function to first move towards more of item2, but then ;; again for less of item1. The point at which this shift occurs is at the ;; golden section (where else?). (let* ((left-num (round (* num-items .618))) (right-num (- num-items left-num)) ;; get the two transitions. (left (fibonacci-transition-aux1 left-num item1 item2)) ;; this one will be reversed (right (fibonacci-transition-aux1 right-num item2 item1))) ;; avoid two item1s at the crossover. we use equal as it can handle number ;; and symbol comparison (when (equal (first (last right)) item1) ;; butlast returns it's argument minus the last element ;; e.g. (butlast '(1 2 3 4)) -> (1 2 3) (setf right (butlast right)) (push item2 right)) ;; append the two lists and return. we can use nreverse (which is more ;; efficient) rather than reverse as we won't need the original version of ;; result (append left (nreverse right)))) ;;; Say you want a transition between two repeating states over a period of x ;;; repetitions; this gives you a gradual break in of the second state using ;;; fibinacci relationships. ;;; is the start item, the item we want to transition towards ;;; e.g. (fibonacci-transition-aux1 21 0 1) -> ;;; (0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 1 0 1 0 1 1) (defun fibonacci-transition-aux1 (num-items &optional (item1 0) (item2 1)) ;; local function: usually done with flet but you can't call flet functions ;; recursively... (labels ((ftar (num) ;; lisp functions can return more than one value (e.g. (floor ;; 3.24) usually you will only want the first value (as in the ;; case of floor) but we can get them all using ;; multiple-value-bind and friends. (multiple-value-bind (series sum) ;; returns a list of descending fib numbers and their sum--this ;; will be < num-items (fibonacci-start-at-2 num) (let ((remainder (- num sum))) (if (> remainder 2) ;; recursive call: what we're looking for is a descending ;; list of fib numbers that total exactly, ;; hence we have to keep doing this until we've got ;; num-items (append series (ftar remainder)) ;; we're done so just store the remainder and return (progn (when (> remainder 0) (push remainder series)) series)))))) ;; we might have something like (2 5 3 2 8 5 3 2) so make sure we sort them ;; in descending order. Note that our sort algorithm takes a function as ;; argument. (fibonacci-transition-aux2 (stable-sort (ftar num-items) #'>) item1 item2))) ;;; Once we have the numbers e.g. (8 5 3 2 1) we convert into indices e.g. ;;; (0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 1 0 1 1) ;;; 8 5 3 2 1 (defun fibonacci-transition-aux2 (list item1 item2) (let ((result '())) (loop for num in list do ;; so each time we have 'num' items, all but one of which are item1 (loop repeat (1- num) do (push item1 result)) (push item2 result)) ;; we've used push so we need to reverse the list before returning (nreverse result))) ;;; Return the fibonacci numbers in a list ending at 0 that add up to a maximum ;;; less than . Returns the fibonacci number < max-sum as a second ;;; value. (defun fibonacci (max-sum) (loop ;; our result will be in descending order with result = '(1 0) ;; the running total of sums with cumulative-sum = 1 for x = 0 for y = 0 ;; the sum of our two most recent numbers. for sum = 0 do (setf x (first result) y (second result) sum (+ x y)) (incf cumulative-sum sum) (when (> cumulative-sum max-sum) ;; we're not using sum this time as we're over our limit. ;; return can be used in loops to exit immediately (return (values result (1+ (- cumulative-sum sum))))) (push sum result))) ;;; Same as fibonacci but eliminates the final 0 and 1s; can also reach max-sum ;;; rather than having to be < it. ;;; (fibonacci 20) -> (8 5 3 2 1 1 0) 20 ;;; (fibonacci-start-at-2 20) -> (8 5 3 2) 18 (defun fibonacci-start-at-2 (max-sum) (multiple-value-bind (series sum) (fibonacci (+ 2 max-sum)) ; + 2 so we can hit max-sum if need be ;; subseq returns a sequence out of our list (values (subseq series 0 (- (length series) 3)) (- sum 2)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; EOF multi-loops.lsp