AM Posted September 15, 2016 Posted September 15, 2016 have fun or delete it... chord-rotation by karel goeyvaerts (his early works), also used/modfied by stockhausen & co, etc... regards a. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;some OLD code -> changed for OMN ;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;; goeyvaerts-rotation -> from "komposition 1";;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; SUBS (defun weighted-random (list) (loop for item in list with rand-num = (random (loop for x in list sum (second x))) for add = (second item) then (+ add (second item)) when (< rand-num add) return (first item))) ;;; (defun weighted-t/nil (on-weight) (let ((off-weight (- 1 on-weight))) (weighted-random (list (list 't on-weight) (list 'nil off-weight))))) ;;; (defun single-pitch-transpose (pitch interval &key (midi-output 'nil)) (if (numberp pitch) (if (equal midi-output 'nil) (midi-to-pitch (+ interval pitch)) (+ interval pitch)) (if (equal midi-output 'nil) (midi-to-pitch (+ interval (pitch-to-midi pitch))) (+ interval (pitch-to-midi pitch))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;MAIN;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun goeyvaerts-rotation (&key pitches static-pitches generations goeyvaerts-transpose-interval (direction 'up) low-border high-border correction-interval) (let ((pitches (filter-remove (pitch-to-midi static-pitches) (pitch-to-midi pitches)))) (midi-to-pitch (append (list (append pitches (pitch-to-midi static-pitches))) (cond ((equal direction 'up) (loop repeat generations collect (append (setf pitches (append (loop for i in pitches when (> i (- (pitch-to-midi high-border) goeyvaerts-transpose-interval)) collect (- i (- (abs correction-interval) 12)) else collect (+ i goeyvaerts-transpose-interval)))) (pitch-to-midi static-pitches)))) ((equal direction 'down) (loop repeat generations collect (append (setf pitches (append (loop for i in pitches when (< i (+ (pitch-to-midi low-border) goeyvaerts-transpose-interval)) collect (+ i correction-interval 12) else collect (- i goeyvaerts-transpose-interval)))) (pitch-to-midi static-pitches))))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (chordize (goeyvaerts-rotation :pitches '(cs2 a2 gs3 d4 bb4 a5 eb6) :static-pitches '(d4) :direction 'down :generations 3 :goeyvaerts-transpose-interval 12 :low-border 'c2 :high-border 'c5 :correction-interval 24)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;put in in a specific interval-to-chord-function ;;;;;;;;;;;;; ;;;;;:type rnd-octaves or goeyvaerts ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun interval-to-chord+ (&key interval-seq startpitch (generations 1) (no-duplicates 'nil) (type 'rnd-octaves) (transpose-intervals '(-12 12)) (transpose-chance 0.5) (arpeggiando 'nil) (goeyvaerts-direction 'up) (goeyvaerts-static-pitches '(c4)) (goeyvaerts-transpose-interval 12) (goeyvaerts-low-border 'c2) (goeyvaerts-high-border 'c5) (goeyvaerts-correction-interval 24) (sorted-asc 't)) (let ((pitches (interval-to-pitch interval-seq :start startpitch))) (setf pitches (if (equal no-duplicates 't) (remove-duplicates pitches) (append pitches))) (setf pitches ;;type with rnd-octaves (cond ((equal type 'rnd-octaves) (loop repeat generations collect (setf pitches (loop for i in pitches collect (single-pitch-transpose i (if (weighted-t/nil transpose-chance) (rnd-pick transpose-intervals) (append 0))))))) ;;type with goeyvaerts-transp -> (from "komposition 1") ((equal type 'goeyvaerts) (goeyvaerts-rotation :pitches pitches :static-pitches goeyvaerts-static-pitches :direction goeyvaerts-direction :generations generations :goeyvaerts-transpose-interval goeyvaerts-transpose-interval :low-border goeyvaerts-low-border :high-border goeyvaerts-high-border :correction-interval goeyvaerts-correction-interval)) (t (append pitches)))) (if (equal sorted-asc 't) (setf pitches (sort-asc pitches))) (if (equal arpeggiando 't) (append pitches) (chordize pitches)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; examples ;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; GOEYVAERTS (pitch-list-plot (flatten (interval-to-chord+ :type 'goeyvaerts :interval-seq '(5 3 3 3 5 3 3 3 5) :generations 10 :startpitch 'c4 :type 'goeyvaerts :goeyvaerts-direction 'up :goeyvaerts-low-border 'c2 :goeyvaerts-high-border 'c5 :goeyvaerts-correction-interval 48 :arpeggiando t :sorted-asc 't))) ;;; RND-OCTAVES (pitch-list-plot (flatten (interval-to-chord+ :type 'rnd-octaves :interval-seq '(5 3 3 3 5 3 3 3 5) :startpitch 'c4 :type 'rnd-octaves :no-duplicates 't :transpose-intervals '(-12 12) :transpose-chance 0.5 :arpeggiando t :sorted-asc 't))) opmo and lviklund 2 Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.