OpenMusic-Library zur regelbasierten Harmonie und Stimmführung.
Lorenz Lehmann
12.02.24 f3e3b20c9bce4a635d3b7a99bc1f02e4310e516b
sources/gen-harmonies.lisp
@@ -9,11 +9,11 @@
(in-package :omlead)
(om::defmethod! gen-harmonies ((pitch-set-list list) (instr1 list) (instr2 list) (instr3 list) (instr4 list) &key (avoid-empty-voices nil) (fundamental 6000) (skala (list 100)) (permutations nil) (register-list '(0)))
(om::defmethod! gen-harmonies ((pitch-set-list list) (instr1 list) (instr2 list) (instr3 list) (instr4 list) &key (avoid-empty-voices nil) (fundamental 6000) (skala (list 100)) (permutations nil) (register-list '(0)) (avoid-doublings nil))
:icon 030719972
:initvals '('((0)) '(6000 7200) nil nil nil)   
:indoc '("a list of lists of intervals respective to a base not in midi-cents" "range-list with the lowest and highest note of the instrument in midi-cents" "range-list with the lowest and highest note of the instrument in midi-cents" "range-list with the lowest and highest note of the instrument in midi-cents" "range-list with the lowest and highest note of the instrument in midi-cents" "list of intervals based on the virtual fundamental which defines the <octave> for register-transposition")
:indoc '("a list of lists of intervals respective to a base not in midi-cents" "range-list with the lowest and highest note of the instrument in midi-cents" "range-list with the lowest and highest note of the instrument in midi-cents" "range-list with the lowest and highest note of the instrument in midi-cents" "range-list with the lowest and highest note of the instrument in midi-cents" "list of intervals based on the virtual fundamental which defines the <octave> for register-transposition" "if true all chords with the same note in two or more instruments will be avoided")
:numouts 1
@@ -65,6 +65,15 @@
                                                          collect
                                                          (loop for reg in (variations_oml register-list (length a))
                                                                collect (mapcar #'(lambda (r p) (+ r p)) reg a))) 1) :test 'equal))
       (harmon-database (cond
                         (avoid-doublings (remove nil (loop for a in harmon-database
                                                collect (if (not (find-dups_oml a)) a nil))))
                         (t harmon-database)
                         ))
       (instr-list2  (list instr1 instr2 instr3 instr4))
       (harmon-database (remove -1 (loop for a in harmon-database
                              collect (loop for p in a
@@ -163,6 +172,12 @@
         (liste (make-list pcl :initial-element liste)))
    (apply #'alexandria:map-product #'list liste)))
(defun find-dups_oml (lst)
  (cond ((null lst) '())
        ((member (car lst) (cdr lst)) (cons (car lst) (find-dups_oml (cdr lst))))
        (t (find-dups_oml (cdr lst)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;end;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;