fix (sources): gen-harmonies

Lorenz Lehmann

28.03.24 28dae6acba357fecd7aca30f025a1d4e626b568c

fix (sources): gen-harmonies

-replace endless-list-operators circular_oml and hold_oml
-adapt filter-harmonies to the filter-concept of gen-sequence

 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,19 +92,14 @@
                       
                       (harmonies 
                        (if (car filter-harmonies)
                        (let ((filter-list harmonies))
                                    

                                    (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 
                            (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 (not (funcall rule (first filter-box) harmony))
                                                                   (delete harmony filter-list))))))
                                    filter-list)
                                                                                    (if (funcall rule (first filter-box) harmony) harmony) harmony)))))
                                    
                          harmonies))
           
;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
@@ -235,6 +222,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 +264,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 +286,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 +331,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)))))



@@ -307,3 +358,6 @@



(let ((a '(1)))
  (delete 1 a))