;====================================== ;OM-Lead, 2022-2023 ; ;Library for Rule-based Voice-Leading ;Author: Lorenz Lehmann ;Supervision: Marlon Schumacher ;====================================== (in-package :omlead) (om::defmethod! harmon-rhythm (harmon_progress measure_numerator measure_denominator n-bars n-harmonies tree-base1 &key tree-base2 tree-base3 tree-base4 (tempo 60) (legato 100) (chan-i1 1) (chan-i2 1) (chan-i3 1) (chan-i4 1) (vel-i1 100) (vel-i2 100) (vel-i3 100) (vel-i4 100) off-sets proportions pulses pause-tie avoid-pause-repetitions) :icon 030719971 :numouts 5 ;:indoc '("tree: a list of trees or a list of lists with trees (((tree) (tree) (tree)))/ (((tree1) (tree2)) ((tree1)))" "chords -> harmon-progress") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun mat-trans_oml (list) (loop for y in (let (count-list) (dotimes (i (length (car list))) (setq count-list (cons i count-list))) (nreverse count-list)) collect (loop for x in list collect (nth y x)))) (defun n-pulses_oml (l) (labels ((pulses (liste) (if (null (car liste)) liste (cond ((atom (car liste)) (cons 1 (pulses (cdr liste)))) (t (pulses (car liste))))))) (length (pulses l)))) (defun nth-rand_oml (liste) (nth (random (length liste)) liste)) (defun list_oml (seq list) (if (null seq) seq (cons (butlast seq (- (length seq) (car list))) (list_oml (nthcdr (car list) seq) (cdr list))))) (defun flat_oml (liste) (cond ((null (cdr liste)) (if (atom (car liste)) liste (flat_oml (car liste)))) ((and (listp (car liste)) (not (listp (cadr liste)))) (append (car liste) (flat_oml (cdr liste)))) ((and (not (listp (car liste))) (not (listp (cadr liste)))) (append (list (car liste)) (flat_oml (cdr liste)))) ((and (listp (car liste)) (listp (cadr liste))) (append (car liste) (flat_oml (cdr liste)))) ((and (not (listp (car liste))) (listp (cadr liste))) (append (list (car liste)) (flat_oml (cdr liste)))))) (defun find-pos_oml (item seq) (remove nil (loop for s in seq for x collect (if (equal item s) x)))) (defun replace_oml (positions item liste) (let ((positions (if (atom positions) (list positions) positions))) (loop for i in liste for p collect (if (find p positions) item i)))) (defun sum_oml (liste) (if (null (cdr liste)) (car liste) (+ (car liste) (sum_oml (cdr liste))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (let* ((n-harms (cond ((atom n-harmonies) (loop repeat n-bars collect n-harmonies)) ((< (length n-harmonies) n-bars) (append n-harmonies (loop repeat (- n-bars (length n-harmonies)) collect (car (last n-harmonies))))) (t n-harmonies))) (voice-list (loop repeat n-bars for trees1 in (cond ((< (length tree-base1) n-bars) (append tree-base1 (loop repeat (- n-bars (length tree-base1)) collect (car (last tree-base1))))) (t tree-base1)) for trees2 in (cond ((< (length tree-base2) n-bars) (append tree-base2 (loop repeat (- n-bars (length tree-base2)) collect (car (last tree-base2))))) (t tree-base2)) for trees3 in (cond ((< (length tree-base3) n-bars) (append tree-base3 (loop repeat (- n-bars (length tree-base3)) collect (car (last tree-base3))))) (t tree-base3)) for trees4 in (cond ((< (length tree-base4) n-bars) (append tree-base4 (loop repeat (- n-bars (length tree-base4)) collect (car (last tree-base4))))) (t tree-base4)) for chords in (list_oml (cond ((atom (car harmon_progress)) (loop repeat (* n-bars n-harmonies) collect harmon_progress)) ((< (length harmon_progress) (* n-bars n-harmonies)) (append harmon_progress (loop repeat (- (* n-bars n-harmonies) (length harmon_progress)) collect (car (last harmon_progress))))) (t harmon_progress)) n-harms) for n-harmony in n-harms for numerator in (cond ((atom measure_numerator) (loop repeat n-bars collect measure_numerator)) ((< (length measure_numerator) n-bars) (append measure_numerator (loop repeat (- n-bars (length measure_numerator)) collect (car (last measure_numerator))))) (t measure_numerator)) for denominator in (cond ((atom measure_denominator) (loop repeat n-bars collect measure_denominator)) ((< (length measure_denominator) n-bars) (append measure_denominator (loop repeat (- n-bars (length measure_denominator)) collect (car (last measure_denominator))))) (t measure_denominator)) for tempo in (cond ((atom tempo) (loop repeat n-bars collect tempo)) ((< (length tempo) n-bars) (append tempo (loop repeat (- n-bars (length tempo)) collect (car (last tempo))))) (t tempo)) for legato in (cond ((atom legato) (loop repeat n-bars collect legato)) ((< (length legato) n-bars) (append legato (loop repeat (- n-bars (length legato)) collect (car (last legato))))) (t legato)) for offs in (print (cond ((< (length off-sets) n-bars) (append off-sets (loop repeat (- n-bars (length off-sets)) collect (car (last off-sets))))) (t off-sets))) for props in (cond ((< (length proportions) n-bars) (append proportions (loop repeat (- n-bars (length proportions)) collect (car (last proportions))))) (t proportions)) for puls in (cond ((< (length pulses) n-bars) (append pulses (loop repeat (- n-bars (length pulses)) collect (car (last pulses))))) (t pulses)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; collect (let* ((voice-num (length (car chords))) (midi-list (loop for instr to (1- voice-num) collect (mapcar #'(lambda (l) (list (nth instr l))) chords))) (trees (list trees1 trees2 trees3 trees4)) (tree-list (loop for l in trees for m in midi-list while l collect ;Tree BARS (list 1 (list (list (list numerator denominator) ;Proportions (if (find -1 (flat_oml m)) (replace_oml (find-pos_oml '(-1) m) -1 (nth-rand_oml (loop for r in l collect (if (= n-harmony (n-pulses_oml r)) r)))) (nth-rand_oml (loop for r in l collect (if (= n-harmony (n-pulses_oml r)) r))))))))) (tree-list (cond (off-sets (setf beats (nth-rand_oml puls)) (setf item (nth-rand_oml props)) (loop for tree in tree-list for x for pattern in (print (make-list (length beats) :initial-element (mapcar #'(lambda (pr pa) (* pr pa)) item (nth x (loop for i in (nth-rand_oml offs) collect (cond ((= 1 i) 1) ((= -1 i) -1) (t -1)) into instr1 collect (cond ((= 2 i) 1) ((= -2 i) -1) (t -1)) into instr2 collect (cond ((= 3 i) 1) ((= -3 i) -1) (t -1)) into instr3 collect (cond ((= 4 i) 1) ((= -4 i) -1) (t -1)) into instr4 finally (return (mapcar #'(lambda (l) (if (= (count -1 l) (length l)) 'nil l)) (list instr1 instr2 instr3 instr4)))))))) do (setf beats (nth-rand_oml puls)) do (setf item (nth-rand_oml props)) collect (om::subst-rhythm tree beats pattern))) (t tree-list))) (midi-list (mapcar #'(lambda (l) (remove '(-1) l :test 'equal)) midi-list)) (chord-lists (loop for instr to (1- voice-num) collect (loop for m in (nth instr midi-list) collect (om::make-instance 'om::chord :lmidic m :lchan '(1) :lvel '(100)))))) ;ergebnis: list of chord-lists ;:::::....... (loop for instr to (1- voice-num) collect (om::make-instance 'om::voice :tree (nth instr tree-list) :chords (nth instr chord-lists) :tempo tempo :legato legato ))))) (voices (loop for x in (mat-trans_oml voice-list) collect (reduce #'om::concat x)))) (values-list (list (reverse voices) (nth 0 voices) (nth 1 voices) (nth 2 voices) (nth 3 voices))) ;;;;;;;;;;;;;end:::::::::::::::::::::::::::::::::::::::::::::::: ))