| 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 | ||
| 12 | (om::defmethod! get-score (harmon-progress &key (measure_numerator 4) (measure_denominator 4) (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) tie-repetitions) | |
| 13 | ||
| 14 | :icon 030719971 | |
| 15 | :indoc '("the list of chords you may have generated in harmon-progress" "number of beats (could be a list or an integer number)" "beat (could be a list or an integer number)" "tempo" "legato" "midi-channel for instr1 (could be a list or an integer number)" "midi-channel for instr2 (could be a list or an integer number)" "midi-channel for instr3 (could be a list or an integer number)" "midi-channel for instr4 (could be a list or an integer number)") | |
| 16 | :numouts 5 | |
| 17 | :doc "A simple version of rhythmic-progress. | |
| 18 | Outlet1: Gives out a voice for each of the four instruments in a list to put in the second inlet of a poly-object. | |
| 19 | Outlet2-5: Gives out a voice for each of the four instruments to put in the first inlet of a voice-object" | |
| 20 | ||
| 21 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 22 | ||
| 23 | (defun mat-trans_oml (list) | |
| 24 | (loop for y in (let (count-list) | |
| 25 | (dotimes (i (length (car list))) | |
| 26 | (setq count-list (cons i count-list))) (nreverse count-list)) | |
| 27 | collect (loop for x in list collect (nth y x)) | |
| 28 | ||
| 29 | )) | |
| 30 | ||
| 31 | ||
| 32 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 33 | ||
| 34 | ||
| 35 | ||
| 36 | (let* ((chordnumber (length harmon-progress)) | |
| 37 | ||
| 38 | (numerator (cond ((atom measure_numerator) (loop repeat chordnumber collect measure_numerator)) | |
| 39 | ((< (length measure_numerator) chordnumber) (append measure_numerator (loop repeat (- chordnumber (length measure_numerator)) collect (car (reverse measure_numerator))))) | |
| 40 | (t measure_numerator))) | |
| 41 | (denominator (cond ((atom measure_denominator) (loop repeat chordnumber collect measure_denominator)) | |
| 42 | ((< (length measure_denominator) chordnumber) (append measure_denominator (loop repeat (- chordnumber (length measure_denominator)) collect (car (reverse measure_denominator))))) | |
| 43 | (t measure_denominator))) | |
| 44 | (voice-list (mat-trans_oml harmon-progress)) | |
| 45 | (channel-list (list (cond ((atom chan-i1) (loop repeat chordnumber collect chan-i1)) | |
| 46 | ((< (length chan-i1) chordnumber) (append chan-i1 (loop repeat (- chordnumber (length chan-i1)) collect (car (reverse chan-i1))))) | |
| 47 | (t chan-i1)) | |
| 48 | (cond ((atom chan-i2) (loop repeat chordnumber collect chan-i2)) | |
| 49 | ((< (length chan-i2) chordnumber) (append chan-i2 (loop repeat (- chordnumber (length chan-i2)) collect (car (reverse chan-i2))))) | |
| 50 | (t chan-i2)) | |
| 51 | (cond ((atom chan-i3) (loop repeat chordnumber collect chan-i3)) | |
| 52 | ((< (length chan-i3) chordnumber) (append chan-i3 (loop repeat (- chordnumber (length chan-i3)) collect (car (reverse chan-i3))))) | |
| 53 | (t chan-i3)) | |
| 54 | (cond ((atom chan-i4) (loop repeat chordnumber collect chan-i4)) | |
| 55 | ((< (length chan-i4) chordnumber) (append chan-i4 (loop repeat (- chordnumber (length chan-i4)) collect (car (reverse chan-i4))))) | |
| 56 | (t chan-i4)))) | |
| 57 | (velocity-list (list (cond ((atom vel-i1) (loop repeat chordnumber collect vel-i1)) | |
| 58 | ((< (length vel-i1) chordnumber) (append vel-i1 (loop repeat (- chordnumber (length vel-i1)) collect (car (reverse vel-i1))))) | |
| 59 | (t vel-i1)) | |
| 60 | (cond ((atom vel-i2) (loop repeat chordnumber collect vel-i2)) | |
| 61 | ((< (length vel-i2) chordnumber) (append vel-i2 (loop repeat (- chordnumber (length vel-i2)) collect (car (reverse vel-i2))))) | |
| 62 | (t vel-i2)) | |
| 63 | (cond ((atom vel-i3) (loop repeat chordnumber collect vel-i3)) | |
| 64 | ((< (length vel-i3) chordnumber) (append vel-i3 (loop repeat (- chordnumber (length vel-i3)) collect (car (reverse vel-i3))))) | |
| 65 | (t vel-i3)) | |
| 66 | (cond ((atom vel-i4) (loop repeat chordnumber collect vel-i4)) | |
| 67 | ((< (length vel-i4) chordnumber) (append vel-i4 (loop repeat (- chordnumber (length vel-i4)) collect (car (reverse vel-i4))))) | |
| 68 | (t vel-i4)))) | |
| 69 | (tree-list (loop for voice in voice-list | |
| 70 | collect | |
| 71 | (list 'om::? (loop for n in numerator | |
| 72 | for d in denominator | |
| 73 | for v in voice | |
| 74 | collect | |
| 75 | (if (eq v -1) (list (append (list n d)) '(-1)) (list (append (list n d)) '(1))))))) | |
| 76 | (tree-list (cond (tie-repetitions | |
| 77 | (loop for voice in voice-list | |
| 78 | for tree in tree-list | |
| 79 | collect | |
| 80 | (list (car tree) | |
| 81 | (loop for x in (cadr tree) | |
| 82 | for v on (append '(x) voice) | |
| 83 | until (< (length v) 2) | |
| 84 | collect | |
| 85 | (list (first x) | |
| 86 | (mapcar (lambda (a b) (* a b)) | |
| 87 | (second x) | |
| 88 | (if (eq (first v) (second v)) | |
| 89 | (append '(1.0) (make-list (1- (length (second x))) :initial-element 1)) | |
| 90 | (make-list (length (second x)) :initial-element 1)))))))) | |
| 91 | (t tree-list))) | |
| 92 | (voice-list (cond (tie-repetitions | |
| 93 | (loop for voice in voice-list | |
| 94 | collect | |
| 95 | (remove nil | |
| 96 | (loop for i on (append '(x) voice) | |
| 97 | until (< (length i) 2) | |
| 98 | collect (if (eq (first i) (second i)) nil (second i)))))) | |
| 99 | (t voice-list))) | |
| 100 | ||
| 101 | (chord-list (loop for voice in voice-list | |
| 102 | for channel in channel-list | |
| 103 | for velocity in velocity-list | |
| 104 | collect | |
| 105 | (remove nil (loop for v in voice | |
| 106 | for c in channel | |
| 107 | for vel in velocity | |
| 108 | collect (if (eq v -1) nil (om::make-instance 'om::chord | |
| 109 | :lmidic (list v) | |
| 110 | :lchan (list c) | |
| 111 | :lvel (list vel))))))) | |
| 112 | (voices (loop for tree in tree-list | |
| 113 | for chords in chord-list | |
| 114 | collect | |
| 115 | (om::make-instance 'om::voice | |
| 116 | :tree tree | |
| 117 | :chords chords | |
| 118 | :tempo tempo | |
| 119 | :legato legato)))) | |
| 120 | ||
| 121 | ||
| 122 | (values-list (list (reverse voices) (nth 0 voices) (nth 1 voices) (nth 2 voices) (nth 3 voices))))) | |
| 123 | ||
| 124 | ||
| 125 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;END;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 126 | ||
