SymProg/OM-Lead.git

			@@ -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))))))

			;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;