From 35fd3d63c7c48602d2160ebee96fbc6ea5bc6a7c Mon Sep 17 00:00:00 2001
From: Lorenz Lehmann <lorenz.lehmann@students.muho-mannheim.de>
Date: Sat, 02 Mar 2024 01:51:28 +0100
Subject: [PATCH] chore (resources): introduce new icons
---
sources/gen-sequence.lisp | 669 ++++++++++++++++++++++++++++++++----------------------
1 files changed, 394 insertions(+), 275 deletions(-)
diff --git a/sources/gen-sequence.lisp b/sources/gen-sequence.lisp
index 521e950..d8424ff 100644
--- a/sources/gen-sequence.lisp
+++ b/sources/gen-sequence.lisp
@@ -156,33 +156,45 @@
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 (setq 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
- (let ((voice-tie1 (- voice-tie1 1)))
- (setq looplist (remove nil
+ (let* ((voice-tie1 (- voice-tie1 1))
+ (looplist (remove nil
(loop for a in temp-base
collect
-
+
(cond ((eq (nth voice-tie1 a) (nth voice-tie1 first)) a)
- ((eq (nth voice-tie1 a) -1) a)
- (t nil)))))
+ ((eq (nth voice-tie1 first) -1) a)
+ (t nil))))))
(if (null looplist)
(loop for a in temp-base
collect
@@ -191,14 +203,14 @@
(t temp-base)))
(temp-base (cond (voice-tie2
- (let ((voice-tie2 (- voice-tie2 1)))
- (setq looplist (remove nil
+ (let* ((voice-tie2 (- voice-tie2 1))
+ (looplist (remove nil
(loop for a in temp-base
collect
(cond ((eq (nth voice-tie2 a) (nth voice-tie2 first)) a)
- ((eq (nth voice-tie2 a) -1) a)
- (t nil)))))
+ ((eq (nth voice-tie2 first) -1) a)
+ (t nil))))))
(if (null looplist)
(loop for a in temp-base
collect
@@ -207,14 +219,14 @@
(t temp-base)))
(temp-base (cond (voice-tie3
- (let ((voice-tie3 (- voice-tie3 1)))
- (setq looplist (remove nil
+ (let* ((voice-tie3 (- voice-tie3 1))
+ (looplist (remove nil
(loop for a in temp-base
collect
(cond ((eq (nth voice-tie3 a) (nth voice-tie3 first)) a)
- ((eq (nth voice-tie3 a) -1) a)
- (t nil)))))
+ ((eq (nth voice-tie3 first) -1) a)
+ (t nil))))))
(if (null looplist)
(loop for a in temp-base
collect
@@ -223,14 +235,14 @@
(t temp-base)))
(temp-base (cond (voice-tie4
- (let ((voice-tie4 (- voice-tie4 1)))
- (setq looplist (remove nil
+ (let* ((voice-tie4 (- voice-tie4 1))
+ (looplist (remove nil
(loop for a in temp-base
collect
(cond ((eq (nth voice-tie4 a) (nth voice-tie4 first)) a)
- ((eq (nth voice-tie4 a) -1) a)
- (t nil)))))
+ ((eq (nth voice-tie4 first) -1) a)
+ (t nil))))))
(if (null looplist)
(loop for a in temp-base
collect
@@ -238,314 +250,421 @@
looplist)))
(t temp-base)))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(temp-base (cond (voice-interval1
- (setq looplist (remove nil (loop for a in temp-base
+ (let ((looplist (remove nil (loop for a in temp-base
collect
(if (or (find (- (nth 0 a) (nth 0 first)) voice-interval1)
- (eq (nth 0 first) -1)) a))))
+ (eq (nth 0 first) -1)) a)))))
(if (null looplist)
(loop for a in temp-base
collect
- (subs-posn_oml a 0 -1)) looplist))
+ (subs-posn_oml a 0 -1)) looplist)))
(t temp-base)))
(temp-base (cond (voice-interval2
- (setq looplist (remove nil (loop for a in temp-base
+ (let ((looplist (remove nil (loop for a in temp-base
collect
(if (or (find (- (nth 1 a) (nth 1 first)) voice-interval2)
- (eq (nth 1 first) -1)) a))))
+ (eq (nth 1 first) -1)) a)))))
(if (null looplist)
(loop for a in temp-base
collect
- (subs-posn_oml a 1 -1)) looplist))
+ (subs-posn_oml a 1 -1)) looplist)))
(t temp-base)))
(temp-base (cond (voice-interval3
- (setq looplist (remove nil (loop for a in temp-base
+ (let ((looplist (remove nil (loop for a in temp-base
collect
(if (or (find (- (nth 2 a) (nth 2 first)) voice-interval3)
- (eq (nth 2 first) -1)) a))))
+ (eq (nth 2 first) -1)) a)))))
(if (null looplist)
(loop for a in temp-base
collect
- (subs-posn_oml a 2 -1)) looplist))
+ (subs-posn_oml a 2 -1)) looplist)))
(t temp-base)))
(temp-base (cond (voice-interval4
- (setq looplist (remove nil (loop for a in temp-base
+ (let ((looplist (remove nil (loop for a in temp-base
collect
(if (or (find (- (nth 3 a) (nth 3 first)) voice-interval4)
- (eq (nth 3 first) -1)) a))))
+ (eq (nth 3 first) -1)) a)))))
(if (null looplist)
(loop for a in temp-base
collect
- (subs-posn_oml a 3 -1)) looplist))
+ (subs-posn_oml a 3 -1)) looplist)))
(t temp-base)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(temp-base (cond (voice-counter1
- (setq looplist (remove nil
- (loop for a in temp-base
- collect
- (let* ((instr-a (1- (first (car voice-counter1)))) ;0
- (instr-b (1- (second (car voice-counter1)))) ;1
- (delta-a (- (nth instr-a a) (nth instr-a first)))
- (delta-b (- (nth instr-b a) (nth instr-b first)))
- (rule (second voice-counter1)))
- (cond (counter-interval1
- (if (eq rule (cond ((and (or (and (< 0 delta-a) (< 0 delta-b))
- (and (> 0 delta-a) (> 0 delta-b))
- (and (= 0 delta-a) (= 0 delta-b)))
- (find (- (nth instr-b a) (nth instr-a a)) counter-interval1)) 'parallel)
- ((and (or (and (< 0 delta-a) (> 0 delta-b))
- (and (> 0 delta-a) (< 0 delta-b)))
- (find (- (nth instr-b a) (nth instr-a a)) counter-interval1)) 'contrary)
- ((and (or (and (or (< 0 delta-a) (> 0 delta-a)) (= 0 delta-b))
- (and (= 0 delta-a) (or (< 0 delta-b) (> 0 delta-b))))
- (find (- (nth instr-b a) (nth instr-a a)) counter-interval1)) 'seiten)))
- a))
-
-
- (t (if (equal rule (cond ((or (and (< 0 delta-a) (< 0 delta-b))
- (and (> 0 delta-a) (> 0 delta-b))
- (and (= 0 delta-a) (= 0 delta-b))) 'parallel)
- ((or (and (< 0 delta-a) (> 0 delta-b))
- (and (> 0 delta-a) (< 0 delta-b))) 'contrary)
- ((or (and (or (< 0 delta-a) (> 0 delta-a)) (= 0 delta-b))
- (and (= 0 delta-a) (or (< 0 delta-b) (> 0 delta-b)))) 'seiten)))
- a)))))))
-
-
- (if (null looplist)
- (loop for a in temp-base
- collect
- (subs-posn_oml a (1- (first (car voice-counter1))) -1)) looplist))
-
-
-
- (t temp-base)))
+ (cond ((and (or (eq -1 (nth (1- (first (car voice-counter1))) first))
+ (eq -1 (nth (1- (second (car voice-counter1))) first))) counter-interval1)
- (temp-base (cond (voice-counter2
- (setq looplist (remove nil
- (loop for a in temp-base
- collect
- (let* ((instr-a (1- (first (car voice-counter2)))) ;0
- (instr-b (1- (second (car voice-counter2)))) ;1
- (delta-a (- (nth instr-a a) (nth instr-a first)))
- (delta-b (- (nth instr-b a) (nth instr-b first)))
- (rule (second voice-counter2)))
- (cond (counter-interval2
- (if (eq rule (cond ((and (or (and (< 0 delta-a) (< 0 delta-b))
- (and (> 0 delta-a) (> 0 delta-b))
- (and (= 0 delta-a) (= 0 delta-b)))
- (find (- (nth instr-b a) (nth instr-a a)) counter-interval2)) 'parallel)
- ((and (or (and (< 0 delta-a) (> 0 delta-b))
- (and (> 0 delta-a) (< 0 delta-b)))
- (find (- (nth instr-b a) (nth instr-a a)) counter-interval2)) 'contrary)
- ((and (or (and (or (< 0 delta-a) (> 0 delta-a)) (= 0 delta-b))
- (and (= 0 delta-a) (or (< 0 delta-b) (> 0 delta-b))))
- (find (- (nth instr-b a) (nth instr-a a)) counter-interval2)) 'seiten)))
- a))
-
-
- (t (if (equal rule (cond ((or (and (< 0 delta-a) (< 0 delta-b))
- (and (> 0 delta-a) (> 0 delta-b))
- (and (= 0 delta-a) (= 0 delta-b))) 'parallel)
- ((or (and (< 0 delta-a) (> 0 delta-b))
- (and (> 0 delta-a) (< 0 delta-b))) 'contrary)
- ((or (and (or (< 0 delta-a) (> 0 delta-a)) (= 0 delta-b))
- (and (= 0 delta-a) (or (< 0 delta-b) (> 0 delta-b)))) 'seiten)))
- a)))))))
+ (remove nil (loop for a in temp-base
+ collect (let* ((instr-a (1- (first (car voice-counter1)))) ;0
+ (instr-b (1- (second (car voice-counter1))))
+ (voice-i (- (nth instr-b a) (nth instr-a a))) )
+ (if (find voice-i counter-interval1) a)))))
+ ((or (eq -1 (nth (1- (first (car voice-counter1))) first))
+ (eq -1 (nth (1- (second (car voice-counter1))) first))) temp-base)
+
+ (t (let ((looplist (remove nil
+ (loop for a in temp-base
+ collect
+ (let* ((instr-a (1- (first (car voice-counter1)))) ;0
+ (instr-b (1- (second (car voice-counter1)))) ;1
+ (delta-a (- (nth instr-a a) (nth instr-a first)))
+ (delta-b (- (nth instr-b a) (nth instr-b first)))
+ (rule (second voice-counter1)))
+ (cond
+
+
+
+
+ (counter-interval1
+ (if (eq rule (cond ((and (or (and (< 0 delta-a) (< 0 delta-b))
+ (and (> 0 delta-a) (> 0 delta-b))
+ (and (= 0 delta-a) (= 0 delta-b)))
+ (find (- (nth instr-b a) (nth instr-a a)) counter-interval1)) 'parallel)
+ ((and (or (and (< 0 delta-a) (> 0 delta-b))
+ (and (> 0 delta-a) (< 0 delta-b)))
+ (find (- (nth instr-b a) (nth instr-a a)) counter-interval1)) 'contrary)
+ ((and (or (and (or (< 0 delta-a) (> 0 delta-a)) (= 0 delta-b))
+ (and (= 0 delta-a) (or (< 0 delta-b) (> 0 delta-b))))
+ (find (- (nth instr-b a) (nth instr-a a)) counter-interval1)) 'seiten)))
+ a))
+
+
+ (t (if (eq rule (cond ((or (and (< 0 delta-a) (< 0 delta-b))
+ (and (> 0 delta-a) (> 0 delta-b))
+ (and (= 0 delta-a) (= 0 delta-b))) 'parallel)
+ ((or (and (< 0 delta-a) (> 0 delta-b))
+ (and (> 0 delta-a) (< 0 delta-b))) 'contrary)
+ ((or (and (or (< 0 delta-a) (> 0 delta-a)) (= 0 delta-b))
+ (and (= 0 delta-a) (or (< 0 delta-b) (> 0 delta-b)))) 'seiten)))
+ a))))))))
+
+
+
+ (if (null looplist)
+ (loop for a in temp-base
+ collect
+ (subs-posn_oml a (1- (first (car voice-counter1))) -1)) looplist)))))
- (if (null looplist)
- (loop for a in temp-base
- collect
- (subs-posn_oml a (1- (first (car voice-counter2))) -1)) looplist))
-
-
(t temp-base)))
- (temp-base (cond (voice-counter3
- (setq looplist (remove nil
- (loop for a in temp-base
- collect
- (let* ((instr-a (1- (first (car voice-counter3)))) ;0
- (instr-b (1- (second (car voice-counter3)))) ;1
- (delta-a (- (nth instr-a a) (nth instr-a first)))
- (delta-b (- (nth instr-b a) (nth instr-b first)))
- (rule (second voice-counter3)))
- (cond (counter-interval3
- (if (eq rule (cond ((and (or (and (< 0 delta-a) (< 0 delta-b))
- (and (> 0 delta-a) (> 0 delta-b))
- (and (= 0 delta-a) (= 0 delta-b)))
- (find (- (nth instr-b a) (nth instr-a a)) counter-interval3)) 'parallel)
- ((and (or (and (< 0 delta-a) (> 0 delta-b))
- (and (> 0 delta-a) (< 0 delta-b)))
- (find (- (nth instr-b a) (nth instr-a a)) counter-interval3)) 'contrary)
- ((and (or (and (or (< 0 delta-a) (> 0 delta-a)) (= 0 delta-b))
- (and (= 0 delta-a) (or (< 0 delta-b) (> 0 delta-b))))
- (find (- (nth instr-b a) (nth instr-a a)) counter-interval3)) 'seiten)))
- a))
-
-
- (t (if (equal rule (cond ((or (and (< 0 delta-a) (< 0 delta-b))
- (and (> 0 delta-a) (> 0 delta-b))
- (and (= 0 delta-a) (= 0 delta-b))) 'parallel)
- ((or (and (< 0 delta-a) (> 0 delta-b))
- (and (> 0 delta-a) (< 0 delta-b))) 'contrary)
- ((or (and (or (< 0 delta-a) (> 0 delta-a)) (= 0 delta-b))
- (and (= 0 delta-a) (or (< 0 delta-b) (> 0 delta-b)))) 'seiten)))
- a)))))))
+(temp-base (cond (voice-counter2
+ (cond ((and (or (eq -1 (nth (1- (first (car voice-counter2))) first))
+ (eq -1 (nth (1- (second (car voice-counter2))) first))) counter-interval2)
+
+ (remove nil (loop for a in temp-base
+ collect (let* ((instr-a (1- (first (car voice-counter2)))) ;0
+ (instr-b (1- (second (car voice-counter2))))
+ (voice-i (- (nth instr-b a) (nth instr-a a))) )
+ (if (find voice-i counter-interval2) a)))))
+
+ ((or (eq -1 (nth (1- (first (car voice-counter2))) first))
+ (eq -1 (nth (1- (second (car voice-counter2))) first))) temp-base)
+
+ (t (let ((looplist (remove nil
+ (loop for a in temp-base
+ collect
+ (let* ((instr-a (1- (first (car voice-counter2)))) ;0
+ (instr-b (1- (second (car voice-counter2)))) ;1
+ (delta-a (- (nth instr-a a) (nth instr-a first)))
+ (delta-b (- (nth instr-b a) (nth instr-b first)))
+ (rule (second voice-counter2)))
+ (cond
+
+
+
+
+ (counter-interval2
+ (if (eq rule (cond ((and (or (and (< 0 delta-a) (< 0 delta-b))
+ (and (> 0 delta-a) (> 0 delta-b))
+ (and (= 0 delta-a) (= 0 delta-b)))
+ (find (- (nth instr-b a) (nth instr-a a)) counter-interval2)) 'parallel)
+ ((and (or (and (< 0 delta-a) (> 0 delta-b))
+ (and (> 0 delta-a) (< 0 delta-b)))
+ (find (- (nth instr-b a) (nth instr-a a)) counter-interval2)) 'contrary)
+ ((and (or (and (or (< 0 delta-a) (> 0 delta-a)) (= 0 delta-b))
+ (and (= 0 delta-a) (or (< 0 delta-b) (> 0 delta-b))))
+ (find (- (nth instr-b a) (nth instr-a a)) counter-interval2)) 'seiten)))
+ a))
+
+
+ (t (if (eq rule (cond ((or (and (< 0 delta-a) (< 0 delta-b))
+ (and (> 0 delta-a) (> 0 delta-b))
+ (and (= 0 delta-a) (= 0 delta-b))) 'parallel)
+ ((or (and (< 0 delta-a) (> 0 delta-b))
+ (and (> 0 delta-a) (< 0 delta-b))) 'contrary)
+ ((or (and (or (< 0 delta-a) (> 0 delta-a)) (= 0 delta-b))
+ (and (= 0 delta-a) (or (< 0 delta-b) (> 0 delta-b)))) 'seiten)))
+ a))))))))
+
+
+
+ (if (null looplist)
+ (loop for a in temp-base
+ collect
+ (subs-posn_oml a (1- (first (car voice-counter2))) -1)) looplist)))))
- (if (null looplist)
- (loop for a in temp-base
- collect
- (subs-posn_oml a (1- (first (car voice-counter3))) -1)) looplist))
-
-
-
- (t temp-base)))
+
+ (t temp-base)))
+
+ (temp-base (cond (voice-counter3
+ (cond ((and (or (eq -1 (nth (1- (first (car voice-counter3))) first))
+ (eq -1 (nth (1- (second (car voice-counter3))) first))) counter-interval3)
- (temp-base (cond (voice-counter4
- (setq looplist (remove nil
- (loop for a in temp-base
- collect
- (let* ((instr-a (1- (first (car voice-counter4)))) ;0
- (instr-b (1- (second (car voice-counter4)))) ;1
- (delta-a (- (nth instr-a a) (nth instr-a first)))
- (delta-b (- (nth instr-b a) (nth instr-b first)))
- (rule (second voice-counter4)))
- (cond (counter-interval4
- (if (eq rule (cond ((and (or (and (< 0 delta-a) (< 0 delta-b))
- (and (> 0 delta-a) (> 0 delta-b))
- (and (= 0 delta-a) (= 0 delta-b)))
- (find (- (nth instr-b a) (nth instr-a a)) counter-interval4)) 'parallel)
- ((and (or (and (< 0 delta-a) (> 0 delta-b))
- (and (> 0 delta-a) (< 0 delta-b)))
- (find (- (nth instr-b a) (nth instr-a a)) counter-interval4)) 'contrary)
- ((and (or (and (or (< 0 delta-a) (> 0 delta-a)) (= 0 delta-b))
- (and (= 0 delta-a) (or (< 0 delta-b) (> 0 delta-b))))
- (find (- (nth instr-b a) (nth instr-a a)) counter-interval4)) 'seiten)))
- a))
-
-
- (t (if (equal rule (cond ((or (and (< 0 delta-a) (< 0 delta-b))
- (and (> 0 delta-a) (> 0 delta-b))
- (and (= 0 delta-a) (= 0 delta-b))) 'parallel)
- ((or (and (< 0 delta-a) (> 0 delta-b))
- (and (> 0 delta-a) (< 0 delta-b))) 'contrary)
- ((or (and (or (< 0 delta-a) (> 0 delta-a)) (= 0 delta-b))
- (and (= 0 delta-a) (or (< 0 delta-b) (> 0 delta-b)))) 'seiten)))
- a)))))))
+ (remove nil (loop for a in temp-base
+ collect (let* ((instr-a (1- (first (car voice-counter3)))) ;0
+ (instr-b (1- (second (car voice-counter3))))
+ (voice-i (- (nth instr-b a) (nth instr-a a))) )
+ (if (find voice-i counter-interval3) a)))))
+ ((or (eq -1 (nth (1- (first (car voice-counter3))) first))
+ (eq -1 (nth (1- (second (car voice-counter3))) first))) temp-base)
+
+ (t (let ((looplist (remove nil
+ (loop for a in temp-base
+ collect
+ (let* ((instr-a (1- (first (car voice-counter3)))) ;0
+ (instr-b (1- (second (car voice-counter3)))) ;1
+ (delta-a (- (nth instr-a a) (nth instr-a first)))
+ (delta-b (- (nth instr-b a) (nth instr-b first)))
+ (rule (second voice-counter3)))
+ (cond
+
+
+
+
+ (counter-interval3
+ (if (eq rule (cond ((and (or (and (< 0 delta-a) (< 0 delta-b))
+ (and (> 0 delta-a) (> 0 delta-b))
+ (and (= 0 delta-a) (= 0 delta-b)))
+ (find (- (nth instr-b a) (nth instr-a a)) counter-interval3)) 'parallel)
+ ((and (or (and (< 0 delta-a) (> 0 delta-b))
+ (and (> 0 delta-a) (< 0 delta-b)))
+ (find (- (nth instr-b a) (nth instr-a a)) counter-interval3)) 'contrary)
+ ((and (or (and (or (< 0 delta-a) (> 0 delta-a)) (= 0 delta-b))
+ (and (= 0 delta-a) (or (< 0 delta-b) (> 0 delta-b))))
+ (find (- (nth instr-b a) (nth instr-a a)) counter-interval3)) 'seiten)))
+ a))
+
+
+ (t (if (eq rule (cond ((or (and (< 0 delta-a) (< 0 delta-b))
+ (and (> 0 delta-a) (> 0 delta-b))
+ (and (= 0 delta-a) (= 0 delta-b))) 'parallel)
+ ((or (and (< 0 delta-a) (> 0 delta-b))
+ (and (> 0 delta-a) (< 0 delta-b))) 'contrary)
+ ((or (and (or (< 0 delta-a) (> 0 delta-a)) (= 0 delta-b))
+ (and (= 0 delta-a) (or (< 0 delta-b) (> 0 delta-b)))) 'seiten)))
+ a))))))))
+
+
+
+ (if (null looplist)
+ (loop for a in temp-base
+ collect
+ (subs-posn_oml a (1- (first (car voice-counter3))) -1)) looplist)))))
- (if (null looplist)
- (loop for a in temp-base
- collect
- (subs-posn_oml a (1- (first (car voice-counter4))) -1)) looplist))
-
-
-
- (t temp-base)))
+
+ (t temp-base)))
- (temp-base (cond (voice-counter5
- (setq looplist (remove nil
- (loop for a in temp-base
- collect
- (let* ((instr-a (1- (first (car voice-counter5)))) ;0
- (instr-b (1- (second (car voice-counter5)))) ;1
- (delta-a (- (nth instr-a a) (nth instr-a first)))
- (delta-b (- (nth instr-b a) (nth instr-b first)))
- (rule (second voice-counter5)))
- (cond (counter-interval5
- (if (eq rule (cond ((and (or (and (< 0 delta-a) (< 0 delta-b))
- (and (> 0 delta-a) (> 0 delta-b))
- (and (= 0 delta-a) (= 0 delta-b)))
- (find (- (nth instr-b a) (nth instr-a a)) counter-interval5)) 'parallel)
- ((and (or (and (< 0 delta-a) (> 0 delta-b))
- (and (> 0 delta-a) (< 0 delta-b)))
- (find (- (nth instr-b a) (nth instr-a a)) counter-interval5)) 'contrary)
- ((and (or (and (or (< 0 delta-a) (> 0 delta-a)) (= 0 delta-b))
- (and (= 0 delta-a) (or (< 0 delta-b) (> 0 delta-b))))
- (find (- (nth instr-b a) (nth instr-a a)) counter-interval5)) 'seiten)))
- a))
-
-
- (t (if (equal rule (cond ((or (and (< 0 delta-a) (< 0 delta-b))
- (and (> 0 delta-a) (> 0 delta-b))
- (and (= 0 delta-a) (= 0 delta-b))) 'parallel)
- ((or (and (< 0 delta-a) (> 0 delta-b))
- (and (> 0 delta-a) (< 0 delta-b))) 'contrary)
- ((or (and (or (< 0 delta-a) (> 0 delta-a)) (= 0 delta-b))
- (and (= 0 delta-a) (or (< 0 delta-b) (> 0 delta-b)))) 'seiten)))
- a)))))))
+ (temp-base (cond (voice-counter4
+ (cond ((and (or (eq -1 (nth (1- (first (car voice-counter4))) first))
+ (eq -1 (nth (1- (second (car voice-counter4))) first))) counter-interval4)
+
+ (remove nil (loop for a in temp-base
+ collect (let* ((instr-a (1- (first (car voice-counter4)))) ;0
+ (instr-b (1- (second (car voice-counter4))))
+ (voice-i (- (nth instr-b a) (nth instr-a a))) )
+ (if (find voice-i counter-interval4) a)))))
+
+ ((or (eq -1 (nth (1- (first (car voice-counter4))) first))
+ (eq -1 (nth (1- (second (car voice-counter4))) first))) temp-base)
+
+ (t (let ((looplist (remove nil
+ (loop for a in temp-base
+ collect
+ (let* ((instr-a (1- (first (car voice-counter4)))) ;0
+ (instr-b (1- (second (car voice-counter4)))) ;1
+ (delta-a (- (nth instr-a a) (nth instr-a first)))
+ (delta-b (- (nth instr-b a) (nth instr-b first)))
+ (rule (second voice-counter4)))
+ (cond
+
+
+
+
+ (counter-interval4
+ (if (eq rule (cond ((and (or (and (< 0 delta-a) (< 0 delta-b))
+ (and (> 0 delta-a) (> 0 delta-b))
+ (and (= 0 delta-a) (= 0 delta-b)))
+ (find (- (nth instr-b a) (nth instr-a a)) counter-interval4)) 'parallel)
+ ((and (or (and (< 0 delta-a) (> 0 delta-b))
+ (and (> 0 delta-a) (< 0 delta-b)))
+ (find (- (nth instr-b a) (nth instr-a a)) counter-interval4)) 'contrary)
+ ((and (or (and (or (< 0 delta-a) (> 0 delta-a)) (= 0 delta-b))
+ (and (= 0 delta-a) (or (< 0 delta-b) (> 0 delta-b))))
+ (find (- (nth instr-b a) (nth instr-a a)) counter-interval4)) 'seiten)))
+ a))
+
+
+ (t (if (eq rule (cond ((or (and (< 0 delta-a) (< 0 delta-b))
+ (and (> 0 delta-a) (> 0 delta-b))
+ (and (= 0 delta-a) (= 0 delta-b))) 'parallel)
+ ((or (and (< 0 delta-a) (> 0 delta-b))
+ (and (> 0 delta-a) (< 0 delta-b))) 'contrary)
+ ((or (and (or (< 0 delta-a) (> 0 delta-a)) (= 0 delta-b))
+ (and (= 0 delta-a) (or (< 0 delta-b) (> 0 delta-b)))) 'seiten)))
+ a))))))))
+
+
+
+ (if (null looplist)
+ (loop for a in temp-base
+ collect
+ (subs-posn_oml a (1- (first (car voice-counter4))) -1)) looplist)))))
- (if (null looplist)
- (loop for a in temp-base
- collect
- (subs-posn_oml a (1- (first (car voice-counter5))) -1)) looplist))
-
-
-
- (t temp-base)))
+
+ (t temp-base)))
- (temp-base (cond (voice-counter6
- (setq looplist (remove nil
- (loop for a in temp-base
- collect
- (let* ((instr-a (1- (first (car voice-counter6)))) ;0
- (instr-b (1- (second (car voice-counter6)))) ;1
- (delta-a (- (nth instr-a a) (nth instr-a first)))
- (delta-b (- (nth instr-b a) (nth instr-b first)))
- (rule (second voice-counter6)))
- (cond (counter-interval6
- (if (eq rule (cond ((and (or (and (< 0 delta-a) (< 0 delta-b))
- (and (> 0 delta-a) (> 0 delta-b))
- (and (= 0 delta-a) (= 0 delta-b)))
- (find (- (nth instr-b a) (nth instr-a a)) counter-interval6)) 'parallel)
- ((and (or (and (< 0 delta-a) (> 0 delta-b))
- (and (> 0 delta-a) (< 0 delta-b)))
- (find (- (nth instr-b a) (nth instr-a a)) counter-interval6)) 'contrary)
- ((and (or (and (or (< 0 delta-a) (> 0 delta-a)) (= 0 delta-b))
- (and (= 0 delta-a) (or (< 0 delta-b) (> 0 delta-b))))
- (find (- (nth instr-b a) (nth instr-a a)) counter-interval6)) 'seiten)))
- a))
-
-
- (t (if (equal rule (cond ((or (and (< 0 delta-a) (< 0 delta-b))
- (and (> 0 delta-a) (> 0 delta-b))
- (and (= 0 delta-a) (= 0 delta-b))) 'parallel)
- ((or (and (< 0 delta-a) (> 0 delta-b))
- (and (> 0 delta-a) (< 0 delta-b))) 'contrary)
- ((or (and (or (< 0 delta-a) (> 0 delta-a)) (= 0 delta-b))
- (and (= 0 delta-a) (or (< 0 delta-b) (> 0 delta-b)))) 'seiten)))
- a)))))))
+ (temp-base (cond (voice-counter5
+ (cond ((and (or (eq -1 (nth (1- (first (car voice-counter5))) first))
+ (eq -1 (nth (1- (second (car voice-counter5))) first))) counter-interval5)
+
+ (remove nil (loop for a in temp-base
+ collect (let* ((instr-a (1- (first (car voice-counter5)))) ;0
+ (instr-b (1- (second (car voice-counter5))))
+ (voice-i (- (nth instr-b a) (nth instr-a a))) )
+ (if (find voice-i counter-interval5) a)))))
+
+ ((or (eq -1 (nth (1- (first (car voice-counter5))) first))
+ (eq -1 (nth (1- (second (car voice-counter5))) first))) temp-base)
+
+ (t (let ((looplist (remove nil
+ (loop for a in temp-base
+ collect
+ (let* ((instr-a (1- (first (car voice-counter5)))) ;0
+ (instr-b (1- (second (car voice-counter5)))) ;1
+ (delta-a (- (nth instr-a a) (nth instr-a first)))
+ (delta-b (- (nth instr-b a) (nth instr-b first)))
+ (rule (second voice-counter5)))
+ (cond
+
+
+
+
+ (counter-interval5
+ (if (eq rule (cond ((and (or (and (< 0 delta-a) (< 0 delta-b))
+ (and (> 0 delta-a) (> 0 delta-b))
+ (and (= 0 delta-a) (= 0 delta-b)))
+ (find (- (nth instr-b a) (nth instr-a a)) counter-interval5)) 'parallel)
+ ((and (or (and (< 0 delta-a) (> 0 delta-b))
+ (and (> 0 delta-a) (< 0 delta-b)))
+ (find (- (nth instr-b a) (nth instr-a a)) counter-interval5)) 'contrary)
+ ((and (or (and (or (< 0 delta-a) (> 0 delta-a)) (= 0 delta-b))
+ (and (= 0 delta-a) (or (< 0 delta-b) (> 0 delta-b))))
+ (find (- (nth instr-b a) (nth instr-a a)) counter-interval5)) 'seiten)))
+ a))
+
+
+ (t (if (eq rule (cond ((or (and (< 0 delta-a) (< 0 delta-b))
+ (and (> 0 delta-a) (> 0 delta-b))
+ (and (= 0 delta-a) (= 0 delta-b))) 'parallel)
+ ((or (and (< 0 delta-a) (> 0 delta-b))
+ (and (> 0 delta-a) (< 0 delta-b))) 'contrary)
+ ((or (and (or (< 0 delta-a) (> 0 delta-a)) (= 0 delta-b))
+ (and (= 0 delta-a) (or (< 0 delta-b) (> 0 delta-b)))) 'seiten)))
+ a))))))))
+
+
+
+ (if (null looplist)
+ (loop for a in temp-base
+ collect
+ (subs-posn_oml a (1- (first (car voice-counter5))) -1)) looplist)))))
- (if (null looplist)
- (loop for a in temp-base
- collect
- (subs-posn_oml a (1- (first (car voice-counter6))) -1)) looplist))
-
-
-
- (t temp-base)))
+
+ (t temp-base)))
+
+
+(temp-base (cond (voice-counter6
+
+ (cond ((and (or (eq -1 (nth (1- (first (car voice-counter6))) first))
+ (eq -1 (nth (1- (second (car voice-counter6))) first))) counter-interval6)
+
+ (remove nil (loop for a in temp-base
+ collect (let* ((instr-a (1- (first (car voice-counter6)))) ;0
+ (instr-b (1- (second (car voice-counter6))))
+ (voice-i (- (nth instr-b a) (nth instr-a a))) )
+ (if (find voice-i counter-interval6) a)))))
+
+ ((or (eq -1 (nth (1- (first (car voice-counter6))) first))
+ (eq -1 (nth (1- (second (car voice-counter6))) first))) temp-base)
+
+ (t (let ((looplist (remove nil
+ (loop for a in temp-base
+ collect
+ (let* ((instr-a (1- (first (car voice-counter6)))) ;0
+ (instr-b (1- (second (car voice-counter6)))) ;1
+ (delta-a (- (nth instr-a a) (nth instr-a first)))
+ (delta-b (- (nth instr-b a) (nth instr-b first)))
+ (rule (second voice-counter6)))
+ (cond
+
+
+
+
+ (counter-interval6
+ (if (eq rule (cond ((and (or (and (< 0 delta-a) (< 0 delta-b))
+ (and (> 0 delta-a) (> 0 delta-b))
+ (and (= 0 delta-a) (= 0 delta-b)))
+ (find (- (nth instr-b a) (nth instr-a a)) counter-interval6)) 'parallel)
+ ((and (or (and (< 0 delta-a) (> 0 delta-b))
+ (and (> 0 delta-a) (< 0 delta-b)))
+ (find (- (nth instr-b a) (nth instr-a a)) counter-interval6)) 'contrary)
+ ((and (or (and (or (< 0 delta-a) (> 0 delta-a)) (= 0 delta-b))
+ (and (= 0 delta-a) (or (< 0 delta-b) (> 0 delta-b))))
+ (find (- (nth instr-b a) (nth instr-a a)) counter-interval6)) 'seiten)))
+ a))
+
+
+ (t (if (eq rule (cond ((or (and (< 0 delta-a) (< 0 delta-b))
+ (and (> 0 delta-a) (> 0 delta-b))
+ (and (= 0 delta-a) (= 0 delta-b))) 'parallel)
+ ((or (and (< 0 delta-a) (> 0 delta-b))
+ (and (> 0 delta-a) (< 0 delta-b))) 'contrary)
+ ((or (and (or (< 0 delta-a) (> 0 delta-a)) (= 0 delta-b))
+ (and (= 0 delta-a) (or (< 0 delta-b) (> 0 delta-b)))) 'seiten)))
+ a))))))))
+
+
+
+ (if (null looplist)
+ (loop for a in temp-base
+ collect
+ (subs-posn_oml a (1- (first (car voice-counter6))) -1)) looplist)))))
+
+
+
+ (t temp-base)))
@@ -564,7 +683,7 @@
- (nreverse (push second external-list))
+ (push second external-list)
(values second))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
--
Gitblit v1.9.1