From 3aae4ab2c334a2df7772480e74950b15758904cd Mon Sep 17 00:00:00 2001
From: Lorenz Lehmann <lorenz.lehmann@students.muho-mannheim.de>
Date: Thu, 28 Mar 2024 22:51:02 +0100
Subject: [PATCH] fix(source): fix voice-range in gen-harmonies
---
sources/gen-harmonies.lisp | 111 +++++++++++++++++++++++++++++++++++++++++--------------
1 files changed, 83 insertions(+), 28 deletions(-)
diff --git a/sources/gen-harmonies.lisp b/sources/gen-harmonies.lisp
index 7308bc5..6ced843 100644
--- a/sources/gen-harmonies.lisp
+++ b/sources/gen-harmonies.lisp
@@ -1,13 +1,3 @@
-
-;======================================
-;OM-Lead, 2022-2024
-;
-;Library for Rule-based Voice-Leading
-;Author: Lorenz Lehmann
-;Supervision: Marlon Schumacher
-;======================================
-
-
(in-package :omlead)
@@ -37,8 +27,9 @@
;;;;;;;;;;;;;;;;;;negativ
- (reverse (loop for i in (if (or (eq 'hold mode) (eq 'hold-mirror mode))
- (hold_oml negativ) (circular_oml negativ)) ;;endless down-list
+ (reverse (loop for counter
+ for i = (if (or (eq 'hold mode) (eq 'hold-mirror mode))
+ (hold-list negativ counter) (circular-list negativ counter)) ;;endless down-list
sum i into total
until (> range-min (- fundamental total))
collect (- fundamental total)
@@ -48,8 +39,9 @@
;;;;;;;;;;;;;;;;;;positiv
- (loop for i in (if (or (eq 'hold mode) (eq 'hold-mirror mode))
- (hold_oml positiv) (circular_oml positiv)) ;;endless up-list
+ (loop for counter
+ for i = (if (or (eq 'hold mode) (eq 'hold-mirror mode))
+ (hold-list positiv counter) (circular-list positiv counter)) ;;endless up-list
sum i into total
until (< range-max (+ fundamental total))
collect (+ fundamental total)))))))
@@ -100,20 +92,19 @@
(harmonies
(if (car filter-harmonies)
- (let ((filter-list harmonies))
+ (remove nil (loop for filter-box in filter-harmonies
+ append (loop for rule in (second filter-box)
+ append (loop for harmony in harmonies
+ collect (if (tester_oml
+ (lambda (x) (and (<= (list-min_oml (third filter-box)) x) (>= (list-max_oml (third filter-box)) x)))
+ harmony)
+ (if (funcall rule (first filter-box) harmony) harmony) harmony)))))
-
- (loop for filter-box in filter-harmonies
- do (loop for rule in (second filter-box)
-
- do (loop for harmony in filter-list
- do (if (tester_oml
- (lambda (x) (and (<= (list-min_oml (third filter-box)) x) (>= (list-max_oml (third filter-box)) x)))
- harmony)
- (if (not (funcall rule (first filter-box) harmony))
- (delete harmony filter-list))))))
- filter-list)
- harmonies))
+ harmonies))
+ (harmonies (remove nil (loop for harmony in (remove-duplicates harmonies :test #'equal)
+ collect (if (find -1 (mapcar (lambda (pitch range)
+ (if (and (<= pitch (list-max_oml range)) (>= pitch (list-min_oml range))) pitch -1))
+ harmony ranges)) nil harmony))))
;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
@@ -235,6 +226,14 @@
+(defun sum_oml (liste &optional (start 0))
+ (cond ((null liste) start)
+ (t (sum_oml (cdr liste) (+ start (car liste))))))
+
+
+
+
+
(defun circular_oml (items)
(setf (cdr (last items)) items)
items)
@@ -269,6 +268,16 @@
+
+
+
+(defun get-pos_oml (positions seq)
+ (let ((positions (if (atom positions) (list positions) positions)))
+ (mapcar #'(lambda (it) (nth it seq)) seq)))
+
+
+
+
(defun permutations_oml (bag)
(if (null bag)
@@ -281,6 +290,44 @@
+(defun modulo_oml (pos liste)
+(append
+(nthcdr pos liste)
+(butlast liste (- (length liste) pos))))
+
+
+
+
+
+(defun register-permut_oml (register-list)
+(remove-duplicates
+ (om::flat
+ (loop for r in register-list
+ collect
+ (mapcar #'(lambda (l) (permutations_oml
+ (append (make-list l :initial-element r)
+ (make-list (- (length register-list) l) :initial-element 0))))
+ (loop for x from 1 to (length register-list)
+ collect x))) 2) :test 'equal))
+
+
+
+
+(defun find-pos_oml (item seq)
+ (remove nil (loop for s in seq
+ for x
+ collect (if (equal item s) x))))
+
+
+
+
+(defun sum_oml (liste)
+ (if (null (cdr liste))
+ (car liste)
+ (+ (car liste)
+ (sum_oml (cdr liste)))))
+
+
(defun variations_oml (liste pcl)
@@ -288,6 +335,14 @@
(liste (make-list pcl :initial-element liste)))
(apply #'alexandria:map-product #'list liste)))
+
+
+
+
+(defun find-dups_oml (lst)
+ (cond ((null lst) '())
+ ((member (car lst) (cdr lst)) (cons (car lst) (find-dups_oml (cdr lst))))
+ (t (find-dups_oml (cdr lst)))))
@@ -306,4 +361,4 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
+
\ No newline at end of file
--
Gitblit v1.9.1