From c11544f81f50d95afab73c11299a1d98bd1c8283 Mon Sep 17 00:00:00 2001
From: Lorenz Lehmann <lorenz.lehmann@students.muho-mannheim.de>
Date: Mon, 11 Dec 2023 17:48:05 +0100
Subject: [PATCH] feat(sources): add feature avoid-empty-voices
---
sources/gen-harmonies.lisp | 19 ++++++++++---------
1 files changed, 10 insertions(+), 9 deletions(-)
diff --git a/sources/gen-harmonies.lisp b/sources/gen-harmonies.lisp
index 5798601..d1ba81a 100644
--- a/sources/gen-harmonies.lisp
+++ b/sources/gen-harmonies.lisp
@@ -9,7 +9,7 @@
(in-package :omlead)
-(om::defmethod! gen-harmonies ((pitch-set-list list) (instr1 list) (instr2 list) (instr3 list) (instr4 list) &key (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)))
:icon 030719972
:initvals '('((0)) '(6000 7200) nil nil nil)
@@ -23,7 +23,7 @@
(defun circular_oml (items)
(setf (cdr (last items)) items)
items)
-
+
(defun flat_oml (liste)
(cond
@@ -158,17 +158,18 @@
collect
(loop for reg in (variations_oml register-list (length a))
collect (mapcar #'(lambda (r p) (+ r p)) reg a))) 1) :test 'equal))
- (instr-list2 (remove nil (list instr1 instr2 instr3 instr4)))
- (harmon-database (loop for a in 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
- for count to (1- (length instr-list2))
+ for c to (1- (length instr-list2))
- collect (if (or (< p (car (nth count instr-list2)))
- (> p (cadr (nth count instr-list2)))) nil p))))
+ collect (if (nth c instr-list2) (if (or (< p (car (nth c instr-list2)))
+ (> p (cadr (nth c instr-list2)))) nil p) -1)) )))
(harmon-database (remove nil (loop for a in harmon-database
- collect (if (> (count nil a) 0) nil a)))))
-harmon-database))
+ collect (if (> (count nil a) 0) nil a))))
+ (harmon-database (if avoid-empty-voices (mapcar (lambda (x) (remove -1 x)) harmon-database) harmon-database)))
+harmon-database))
--
Gitblit v1.9.1