| commit | author | age | ||
| 71cec5 | 1 | ;====================================== |
| MS | 2 | ;OM-Lead, 2022-2023 |
| 3 | ; | |
| 4 | ;Library for Rule-based Voice-Leading | |
| 5 | ;Author: Lorenz Lehmann | |
| 6 | ;Supervision: Marlon Schumacher | |
| 7 | ;====================================== | |
| 8 | ||
| 9 | (in-package :omlead) | |
| 10 | ||
| 11 | (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) | |
| 12 | ||
| 13 | :icon 030719971 | |
| 14 | :numouts 5 | |
| 15 | ;:indoc '("tree: a list of trees or a list of lists with trees (((tree) (tree) (tree)))/ (((tree1) (tree2)) ((tree1)))" "chords -> harmon-progress") | |
| 16 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 17 | ||
| 18 | (defun mat-trans_oml (list) | |
| 19 | (loop for y in (let (count-list) | |
| 20 | (dotimes (i (length (car list))) | |
| 21 | (setq count-list (cons i count-list))) (nreverse count-list)) | |
| 22 | collect (loop for x in list collect (nth y x)))) | |
| 23 | ||
| 24 | ||
| 25 | ||
| 26 | (defun n-pulses_oml (l) | |
| 27 | (labels ((pulses (liste) | |
| 28 | (if (null (car liste)) | |
| 29 | liste | |
| 30 | (cond ((atom (car liste)) | |
| 31 | (cons 1 | |
| 32 | (pulses (cdr liste)))) | |
| 33 | (t (pulses (car liste))))))) | |
| 34 | (length (pulses l)))) | |
| 35 | ||
| 36 | ||
| 37 | (defun nth-rand_oml (liste) | |
| 38 | (nth (random (length liste)) liste)) | |
| 39 | ||
| 40 | ||
| 41 | (defun list_oml (seq list) | |
| 42 | ||
| 43 | (if (null seq) | |
| 44 | seq | |
| 45 | (cons (butlast seq (- (length seq) (car list))) | |
| 46 | (list_oml (nthcdr (car list) seq) (cdr list))))) | |
| 47 | ||
| 48 | ||
| 49 | (defun flat_oml (liste) | |
| 50 | (cond | |
| 51 | ((null (cdr liste)) | |
| 52 | (if (atom (car liste)) | |
| 53 | liste | |
| 54 | (flat_oml (car liste)))) | |
| 55 | ||
| 56 | ||
| 57 | ((and (listp (car liste)) (not (listp (cadr liste)))) | |
| 58 | (append (car liste) | |
| 59 | (flat_oml (cdr liste)))) | |
| 60 | ||
| 61 | ||
| 62 | ((and (not (listp (car liste))) (not (listp (cadr liste)))) | |
| 63 | (append (list (car liste)) | |
| 64 | (flat_oml (cdr liste)))) | |
| 65 | ||
| 66 | ((and (listp (car liste)) (listp (cadr liste))) | |
| 67 | (append (car liste) | |
| 68 | (flat_oml (cdr liste)))) | |
| 69 | ||
| 70 | ((and (not (listp (car liste))) (listp (cadr liste))) | |
| 71 | (append (list (car liste)) | |
| 72 | (flat_oml (cdr liste)))))) | |
| 73 | ||
| 74 | ||
| 75 | (defun find-pos_oml (item seq) | |
| 76 | (remove nil (loop for s in seq | |
| 77 | for x | |
| 78 | collect (if (equal item s) x)))) | |
| 79 | ||
| 80 | ||
| 81 | (defun replace_oml (positions item liste) | |
| 82 | (let ((positions (if (atom positions) (list positions) positions))) | |
| 83 | (loop for i in liste | |
| 84 | for p | |
| 85 | collect (if (find p positions) item i)))) | |
| 86 | ||
| 87 | ||
| 88 | (defun sum_oml (liste) | |
| 89 | (if (null (cdr liste)) | |
| 90 | (car liste) | |
| 91 | (+ (car liste) | |
| 92 | (sum_oml (cdr liste))))) | |
| 93 | ||
| 94 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 95 | (let* ((n-harms (cond ((atom n-harmonies) (loop repeat n-bars collect n-harmonies)) | |
| 96 | ((< (length n-harmonies) n-bars) | |
| 97 | (append n-harmonies (loop repeat (- n-bars (length n-harmonies)) collect (car (last n-harmonies))))) | |
| 98 | (t n-harmonies))) | |
| 99 | (voice-list | |
| 100 | (loop repeat n-bars | |
| 101 | ||
| 102 | ||
| 103 | for trees1 in (cond ((< (length tree-base1) n-bars) | |
| 104 | (append tree-base1 (loop repeat (- n-bars (length tree-base1)) collect (car (last tree-base1))))) | |
| 105 | (t tree-base1)) | |
| 106 | for trees2 in (cond ((< (length tree-base2) n-bars) | |
| 107 | (append tree-base2 (loop repeat (- n-bars (length tree-base2)) collect (car (last tree-base2))))) | |
| 108 | (t tree-base2)) | |
| 109 | for trees3 in (cond ((< (length tree-base3) n-bars) | |
| 110 | (append tree-base3 (loop repeat (- n-bars (length tree-base3)) collect (car (last tree-base3))))) | |
| 111 | (t tree-base3)) | |
| 112 | for trees4 in (cond ((< (length tree-base4) n-bars) | |
| 113 | (append tree-base4 (loop repeat (- n-bars (length tree-base4)) collect (car (last tree-base4))))) | |
| 114 | (t tree-base4)) | |
| 115 | ||
| 116 | for chords in (list_oml (cond ((atom (car harmon_progress)) (loop repeat (* n-bars n-harmonies) collect harmon_progress)) | |
| 117 | ((< (length harmon_progress) (* n-bars n-harmonies)) | |
| 118 | (append harmon_progress | |
| 119 | (loop repeat (- (* n-bars n-harmonies) (length harmon_progress)) collect (car (last harmon_progress))))) | |
| 120 | (t harmon_progress)) n-harms) | |
| 121 | ||
| 122 | ||
| 123 | ||
| 124 | for n-harmony in n-harms | |
| 125 | for numerator in (cond ((atom measure_numerator) (loop repeat n-bars collect measure_numerator)) | |
| 126 | ((< (length measure_numerator) n-bars) | |
| 127 | (append measure_numerator (loop repeat (- n-bars (length measure_numerator)) collect (car (last measure_numerator))))) | |
| 128 | (t measure_numerator)) | |
| 129 | for denominator in (cond ((atom measure_denominator) (loop repeat n-bars collect measure_denominator)) | |
| 130 | ((< (length measure_denominator) n-bars) | |
| 131 | (append measure_denominator (loop repeat (- n-bars (length measure_denominator)) collect (car (last measure_denominator))))) | |
| 132 | (t measure_denominator)) | |
| 133 | for tempo in (cond ((atom tempo) (loop repeat n-bars collect tempo)) | |
| 134 | ((< (length tempo) n-bars) | |
| 135 | (append tempo (loop repeat (- n-bars (length tempo)) collect (car (last tempo))))) | |
| 136 | (t tempo)) | |
| 137 | for legato in (cond ((atom legato) (loop repeat n-bars collect legato)) | |
| 138 | ((< (length legato) n-bars) | |
| 139 | (append legato (loop repeat (- n-bars (length legato)) collect (car (last legato))))) | |
| 140 | (t legato)) | |
| 141 | ||
| 142 | for offs in (print (cond ((< (length off-sets) n-bars) | |
| 143 | (append off-sets (loop repeat (- n-bars (length off-sets)) collect (car (last off-sets))))) | |
| 144 | (t off-sets))) | |
| 145 | for props in (cond ((< (length proportions) n-bars) | |
| 146 | (append proportions (loop repeat (- n-bars (length proportions)) collect (car (last proportions))))) | |
| 147 | (t proportions)) | |
| 148 | ||
| 149 | for puls in (cond ((< (length pulses) n-bars) | |
| 150 | (append pulses (loop repeat (- n-bars (length pulses)) collect (car (last pulses))))) | |
| 151 | (t pulses)) | |
| 152 | ||
| 153 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 154 | ||
| 155 | collect | |
| 156 | ||
| 157 | ||
| 158 | ||
| 159 | (let* | |
| 160 | ((voice-num (length (car chords))) | |
| 161 | (midi-list (loop for instr to (1- voice-num) | |
| 162 | collect | |
| 163 | (mapcar #'(lambda (l) (list (nth instr l))) chords))) | |
| 164 | (trees (list trees1 trees2 trees3 trees4)) | |
| 165 | (tree-list (loop for l in trees | |
| 166 | for m in midi-list | |
| 167 | while l | |
| 168 | collect | |
| 169 | ;Tree BARS | |
| 170 | (list 1 (list (list (list numerator denominator) | |
| 171 | ;Proportions | |
| 172 | (if (find -1 (flat_oml m)) | |
| 173 | (replace_oml (find-pos_oml '(-1) m) -1 | |
| 174 | ||
| 175 | (nth-rand_oml | |
| 176 | (loop for r in l | |
| 177 | collect (if (= n-harmony (n-pulses_oml r)) r)))) | |
| 178 | (nth-rand_oml | |
| 179 | (loop for r in l | |
| 180 | collect (if (= n-harmony (n-pulses_oml r)) r))))))))) | |
| 181 | ||
| 182 | (tree-list (cond (off-sets | |
| 183 | ||
| 184 | (setf beats (nth-rand_oml puls)) | |
| 185 | (setf item (nth-rand_oml props)) | |
| 186 | (loop for tree in tree-list | |
| 187 | ||
| 188 | for x | |
| 189 | for pattern in (print (make-list (length beats) | |
| 190 | :initial-element (mapcar #'(lambda (pr pa) (* pr pa)) | |
| 191 | item | |
| 192 | (nth x | |
| 193 | (loop for i in (nth-rand_oml offs) | |
| 194 | collect (cond ((= 1 i) 1) ((= -1 i) -1) (t -1)) into instr1 | |
| 195 | collect (cond ((= 2 i) 1) ((= -2 i) -1) (t -1)) into instr2 | |
| 196 | collect (cond ((= 3 i) 1) ((= -3 i) -1) (t -1)) into instr3 | |
| 197 | collect (cond ((= 4 i) 1) ((= -4 i) -1) (t -1)) into instr4 | |
| 198 | ||
| 199 | finally (return (mapcar #'(lambda (l) (if (= (count -1 l) (length l)) 'nil l)) | |
| 200 | (list instr1 instr2 instr3 instr4)))))))) | |
| 201 | do (setf beats (nth-rand_oml puls)) | |
| 202 | do (setf item (nth-rand_oml props)) | |
| 203 | collect | |
| 204 | ||
| 205 | ||
| 206 | (om::subst-rhythm tree beats pattern))) | |
| 207 | ||
| 208 | (t tree-list))) | |
| 209 | ||
| 210 | ||
| 211 | ||
| 212 | (midi-list | |
| 213 | ||
| 214 | (mapcar #'(lambda (l) (remove '(-1) l :test 'equal)) midi-list)) | |
| 215 | ||
| 216 | (chord-lists | |
| 217 | ||
| 218 | (loop for instr to (1- voice-num) | |
| 219 | collect (loop for m in (nth instr midi-list) | |
| 220 | collect (om::make-instance 'om::chord | |
| 221 | :lmidic m | |
| 222 | :lchan '(1) | |
| 223 | :lvel '(100)))))) | |
| 224 | ||
| 225 | ;ergebnis: list of chord-lists | |
| 226 | ||
| 227 | ;:::::....... | |
| 228 | ||
| 229 | ||
| 230 | ||
| 231 | ||
| 232 | (loop for instr to (1- voice-num) | |
| 233 | collect | |
| 234 | (om::make-instance 'om::voice | |
| 235 | :tree (nth instr tree-list) | |
| 236 | :chords (nth instr chord-lists) | |
| 237 | :tempo tempo | |
| 238 | :legato legato | |
| 239 | ))))) | |
| 240 | ||
| 241 | (voices (loop for x in (mat-trans_oml voice-list) | |
| 242 | collect (reduce #'om::concat x)))) | |
| 243 | ||
| 244 | ||
| 245 | (values-list (list (reverse voices) (nth 0 voices) (nth 1 voices) (nth 2 voices) (nth 3 voices))) | |
| 246 | ||
| 247 | ||
| 248 | ;;;;;;;;;;;;;end:::::::::::::::::::::::::::::::::::::::::::::::: | |
| 249 | )) | |
| 250 | ||
| 251 | ||
| 252 | ||
| 253 | ||
| 254 | ||
| 255 | ||
| 256 | ||
| 257 | ||
| 258 | ||
| 259 | ||
| 260 | ||
| 261 | ||
| 262 | ||
| 263 | ||
| 264 | ||
| 265 | ||
| 266 | ||
