feat(sources): avoid-doublings

Lorenz Lehmann

30.12.23 2b28dadf2717822f52e944d2b4b4542809281b55

 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 '((1 2 3 4) (6 6 7 7) (8 8 8 8) (2 3 4 1))
                                                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;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;