feat(source)!: restructure gen-harmonies

Lorenz Lehmann

20.03.24 c38e61a5cdef40363917766213f707ada93d765b

 sources/gen-sequence.lisp

@@ -156,22 +156,34 @@


                collect
                (let* ((second (nconc (list first-harmony) external-list))
                (let* ((second (append (list first-harmony) (reverse external-list)))
                       (first (car (last second)));6000 6700
                       (second (let* ((temp-base database)
                                      
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

                          (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 
@@ -671,7 +683,7 @@
                  
                  
                  
                  (nreverse (push second external-list))
                  (push second external-list)
                  (values second))))))
               
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;