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