;====================================== ;OM-Lead, 2022-2023 ; ;Library for Rule-based Voice-Leading ;Author: Lorenz Lehmann ;Supervision: Marlon Schumacher ;====================================== (in-package :omlead) (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) :icon 030719971 :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)") :numouts 5 :doc "A simple version of rhythmic-progress. Outlet1: Gives out a voice for each of the four instruments in a list to put in the second inlet of a poly-object. Outlet2-5: Gives out a voice for each of the four instruments to put in the first inlet of a voice-object" ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (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)) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (let* ((chordnumber (length harmon-progress)) (numerator (cond ((atom measure_numerator) (loop repeat chordnumber collect measure_numerator)) ((< (length measure_numerator) chordnumber) (append measure_numerator (loop repeat (- chordnumber (length measure_numerator)) collect (car (reverse measure_numerator))))) (t measure_numerator))) (denominator (cond ((atom measure_denominator) (loop repeat chordnumber collect measure_denominator)) ((< (length measure_denominator) chordnumber) (append measure_denominator (loop repeat (- chordnumber (length measure_denominator)) collect (car (reverse measure_denominator))))) (t measure_denominator))) (voice-list (mat-trans_oml harmon-progress)) (channel-list (list (cond ((atom chan-i1) (loop repeat chordnumber collect chan-i1)) ((< (length chan-i1) chordnumber) (append chan-i1 (loop repeat (- chordnumber (length chan-i1)) collect (car (reverse chan-i1))))) (t chan-i1)) (cond ((atom chan-i2) (loop repeat chordnumber collect chan-i2)) ((< (length chan-i2) chordnumber) (append chan-i2 (loop repeat (- chordnumber (length chan-i2)) collect (car (reverse chan-i2))))) (t chan-i2)) (cond ((atom chan-i3) (loop repeat chordnumber collect chan-i3)) ((< (length chan-i3) chordnumber) (append chan-i3 (loop repeat (- chordnumber (length chan-i3)) collect (car (reverse chan-i3))))) (t chan-i3)) (cond ((atom chan-i4) (loop repeat chordnumber collect chan-i4)) ((< (length chan-i4) chordnumber) (append chan-i4 (loop repeat (- chordnumber (length chan-i4)) collect (car (reverse chan-i4))))) (t chan-i4)))) (velocity-list (list (cond ((atom vel-i1) (loop repeat chordnumber collect vel-i1)) ((< (length vel-i1) chordnumber) (append vel-i1 (loop repeat (- chordnumber (length vel-i1)) collect (car (reverse vel-i1))))) (t vel-i1)) (cond ((atom vel-i2) (loop repeat chordnumber collect vel-i2)) ((< (length vel-i2) chordnumber) (append vel-i2 (loop repeat (- chordnumber (length vel-i2)) collect (car (reverse vel-i2))))) (t vel-i2)) (cond ((atom vel-i3) (loop repeat chordnumber collect vel-i3)) ((< (length vel-i3) chordnumber) (append vel-i3 (loop repeat (- chordnumber (length vel-i3)) collect (car (reverse vel-i3))))) (t vel-i3)) (cond ((atom vel-i4) (loop repeat chordnumber collect vel-i4)) ((< (length vel-i4) chordnumber) (append vel-i4 (loop repeat (- chordnumber (length vel-i4)) collect (car (reverse vel-i4))))) (t vel-i4)))) (tree-list (loop for voice in voice-list collect (list 'om::? (loop for n in numerator for d in denominator for v in voice collect (if (eq v -1) (list (append (list n d)) '(-1)) (list (append (list n d)) '(1))))))) (tree-list (cond (tie-repetitions (loop for voice in voice-list for tree in tree-list collect (list (car tree) (loop for x in (cadr tree) for v on (append '(x) voice) until (< (length v) 2) collect (list (first x) (mapcar (lambda (a b) (* a b)) (second x) (if (eq (first v) (second v)) (append '(1.0) (make-list (1- (length (second x))) :initial-element 1)) (make-list (length (second x)) :initial-element 1)))))))) (t tree-list))) (voice-list (cond (tie-repetitions (loop for voice in voice-list collect (remove nil (loop for i on (append '(x) voice) until (< (length i) 2) collect (if (eq (first i) (second i)) nil (second i)))))) (t voice-list))) (chord-list (loop for voice in voice-list for channel in channel-list for velocity in velocity-list collect (remove nil (loop for v in voice for c in channel for vel in velocity collect (if (eq v -1) nil (om::make-instance 'om::chord :lmidic (list v) :lchan (list c) :lvel (list vel))))))) (voices (loop for tree in tree-list for chords in chord-list collect (om::make-instance 'om::voice :tree tree :chords chords :tempo tempo :legato legato)))) (values-list (list (reverse voices) (nth 0 voices) (nth 1 voices) (nth 2 voices) (nth 3 voices))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;END;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;