;======================================
|
;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::::::::::::::::::::::::::::::::::::::::::::::::
|
))
|
