From c38e61a5cdef40363917766213f707ada93d765b Mon Sep 17 00:00:00 2001
From: Lorenz Lehmann <lorenz.lehmann@students.muho-mannheim.de>
Date: Wed, 20 Mar 2024 18:37:13 +0100
Subject: [PATCH] feat(source)!: restructure gen-harmonies

---
 sources/gen-sequence.lisp |   32 ++++++++++++++++++++++----------
 1 files changed, 22 insertions(+), 10 deletions(-)

diff --git a/sources/gen-sequence.lisp b/sources/gen-sequence.lisp
index 9cf5e47..d8424ff 100644
--- a/sources/gen-sequence.lisp
+++ b/sources/gen-sequence.lisp
@@ -162,16 +162,28 @@
                                       
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-                          (temp-base (cond (avoid-repetitions (let ((looplist 
-                                                                    (remove nil (loop for a in temp-base
-                                                                                      collect (if 
-                                                                                                  (car 
-                                                                                                   (remove nil 
-                                                                                                           (mapcar #'(lambda (l) (eq (car l) (cadr l)))
-                                                                                                                   (mat-trans_oml (list first a))))) nil a)))))
-                                                                    
-                                             (if (null looplist) (list (loop repeat (length (first temp-base)) collect -1)) looplist)))
-                                           (t temp-base))) 
+                          (temp-base (cond (avoid-repetitions 
+                                            (let* ((tie-list (mapcar '1- (remove nil (list voice-tie1 voice-tie2 voice-tie3 voice-tie4))))
+                                                    (sub-list (cond
+                                                               (tie-list (flat_oml (mapcar #'(lambda (l) (subs-posn_oml (loop repeat (length first) collect -2) l -1)) tie-list)))
+                                                               (t '(-2 -2 -2 -2))))
+                                                    
+                                                    
+                                                    (looplist
+                                                     (remove nil (loop for a in temp-base
+                                                                       collect (let ((harmony
+                                                                                      (remove nil (loop for i in sub-list
+                                                                                                        for n1 in first
+                                                                                                        for n2 in a
+                                                                                                        collect (if (cond ((eq i -1) (eq n1 n2))
+                                                                                                                          (t (not (eq n1 n2))))
+                                                                                                                    
+                                                                                                                    n2))))) 
+                                                                                 
+                                                                                 (if (eq (length first) (length harmony)) harmony))))))
+                                              
+                                              (if (null looplist) (list (loop repeat (length (first temp-base)) collect -1)) looplist)))
+                                            (t temp-base)))  
 
 
                          (temp-base (cond (voice-tie1 

--
Gitblit v1.9.1