From 2b28dadf2717822f52e944d2b4b4542809281b55 Mon Sep 17 00:00:00 2001
From: Lorenz Lehmann <lorenz.lehmann@students.muho-mannheim.de>
Date: Sat, 30 Dec 2023 10:57:07 +0100
Subject: [PATCH] feat(sources): avoid-doublings
---
sources/gen-harmonies.lisp | 19 +++++++++++++++++--
1 files changed, 17 insertions(+), 2 deletions(-)
diff --git a/sources/gen-harmonies.lisp b/sources/gen-harmonies.lisp
index 8b1a64e..f9266d0 100644
--- a/sources/gen-harmonies.lisp
+++ b/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;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
--
Gitblit v1.9.1