From a53ccfa7cc59f72f88c55df3a9b1e5583dd2f8b6 Mon Sep 17 00:00:00 2001
From: Lorenz Lehmann <lorenz.lehmann@students.muho-mannheim.de>
Date: Sat, 30 Dec 2023 09:05:59 +0100
Subject: [PATCH] chore(sources): seperate utilities from defmethods
---
sources/harmon-progress.lisp | 75 +++++++-------
sources/gen-harmonies.lisp | 179 +++++++++++++++++------------------
2 files changed, 125 insertions(+), 129 deletions(-)
diff --git a/sources/gen-harmonies.lisp b/sources/gen-harmonies.lisp
index d1ba81a..8b1a64e 100644
--- a/sources/gen-harmonies.lisp
+++ b/sources/gen-harmonies.lisp
@@ -18,100 +18,7 @@
:numouts 1
:doc "creates a list of chords, that contains all possible transpositions & permutations of the given pitch-sets"
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defun circular_oml (items)
-(setf (cdr (last items)) items)
-items)
-
-
-(defun flat_oml (liste)
- (cond
- ((null (cdr liste))
- (if (atom (car liste))
- liste
- (flat_oml (car liste))))
-
-
- ((and (listp (car liste)) (not (listp (cadr liste))))
- (append (car liste)
- (flat_oml (cdr liste))))
-
-
- ((and (not (listp (car liste))) (not (listp (cadr liste))))
- (append (list (car liste))
- (flat_oml (cdr liste))))
-
- ((and (listp (car liste)) (listp (cadr liste)))
- (append (car liste)
- (flat_oml (cdr liste))))
-
- ((and (not (listp (car liste))) (listp (cadr liste)))
- (append (list (car liste))
- (flat_oml (cdr liste))))))
-
-(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)
-'(())
-
-(mapcan #'(lambda (e)
- (mapcar #' (lambda (p) (cons e p))
- (permutations_oml (remove e bag :count 1 :test #'eq))))
- bag)))
-
-
-(defun mat-trans_oml (list)
-(loop for y in (let (count-list)
- (dotimes (i (length (car list)))
- (setq count-list (cons i count-list))) (nreverse count-list))
-collect (loop for x in list collect (nth y x))
-
-))
-
-
-
-(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)
- (let* ((liste (remove-duplicates liste))
- (liste (make-list pcl :initial-element liste)))
- (apply #'alexandria:map-product #'list liste)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(let* (
(instr-list (sort (flat_oml (remove nil (list instr1 instr2 instr3 instr4))) '<))
@@ -171,7 +78,93 @@
(harmon-database (if avoid-empty-voices (mapcar (lambda (x) (remove -1 x)) harmon-database) harmon-database)))
harmon-database))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun circular_oml (items)
+(setf (cdr (last items)) items)
+items)
+
+
+(defun flat_oml (liste)
+ (cond
+ ((null (cdr liste))
+ (if (atom (car liste))
+ liste
+ (flat_oml (car liste))))
+
+
+ ((and (listp (car liste)) (not (listp (cadr liste))))
+ (append (car liste)
+ (flat_oml (cdr liste))))
+
+
+ ((and (not (listp (car liste))) (not (listp (cadr liste))))
+ (append (list (car liste))
+ (flat_oml (cdr liste))))
+
+ ((and (listp (car liste)) (listp (cadr liste)))
+ (append (car liste)
+ (flat_oml (cdr liste))))
+
+ ((and (not (listp (car liste))) (listp (cadr liste)))
+ (append (list (car liste))
+ (flat_oml (cdr liste))))))
+
+(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)
+'(())
+
+(mapcan #'(lambda (e)
+ (mapcar #' (lambda (p) (cons e p))
+ (permutations_oml (remove e bag :count 1 :test #'eq))))
+ bag)))
+
+
+
+
+(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)
+ (let* ((liste (remove-duplicates liste))
+ (liste (make-list pcl :initial-element liste)))
+ (apply #'alexandria:map-product #'list liste)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;end;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/sources/harmon-progress.lisp b/sources/harmon-progress.lisp
index 4c6b48f..9609f14 100644
--- a/sources/harmon-progress.lisp
+++ b/sources/harmon-progress.lisp
@@ -6,6 +6,9 @@
;Supervision: Marlon Schumacher
;======================================
+
+
+
(in-package :omlead)
(om::defmethod! harmon-progress (harmon-database first-chord chordnumber &key avoid-repetitions voice-tie1 voice-tie2 voice-tie3 voice-tie4 voice-interval1 voice-interval2 voice-interval3 voice-interval4 voice-counter1 counter-interval1 voice-counter2 counter-interval2 voice-counter3 counter-interval3 voice-counter4 counter-interval4 voice-counter5 counter-interval5 voice-counter6 counter-interval6 base-list)
@@ -14,42 +17,7 @@
:numouts 1
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defun mat-trans_oml (list)
-(loop for y in (let (count-list)
- (dotimes (i (length (car list)))
- (setq count-list (cons i count-list))) (nreverse count-list))
-collect (loop for x in list collect (nth y x))
-
-))
-
-
-(defun posn-match_oml (list positions)
- (cond ((null positions) '())
- ((atom positions) (nth positions list))
- (t (append (list (posn-match_oml list (car positions)))
- (if (posn-match_oml list (cdr positions))
- (posn-match_oml list (cdr positions))
- '())))))
-
-
-(defun subs-posn_oml (list position item)
- (loop for a from 0
- for b in list
- collect (if (= a position) item b)))
-
-
-(defun oml- (list atom)
-(mapcar (lambda (it) (- it atom)) list))
-
-
-(defun find-dups_oml (liste)
-(car
-(remove nil
-(mapcar #'(lambda (l c) (eq l c)) liste (cdr liste)))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(let* ((harmon-database harmon-database)
@@ -613,7 +581,42 @@
(nreverse (push second external-list))
(values second))))))
-
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun mat-trans_oml (list)
+(loop for y in (let (count-list)
+ (dotimes (i (length (car list)))
+ (setq count-list (cons i count-list))) (nreverse count-list))
+collect (loop for x in list collect (nth y x))
+
+))
+
+
+(defun posn-match_oml (list positions)
+ (cond ((null positions) '())
+ ((atom positions) (nth positions list))
+ (t (append (list (posn-match_oml list (car positions)))
+ (if (posn-match_oml list (cdr positions))
+ (posn-match_oml list (cdr positions))
+ '())))))
+
+
+(defun subs-posn_oml (list position item)
+ (loop for a from 0
+ for b in list
+ collect (if (= a position) item b)))
+
+
+(defun oml- (list atom)
+(mapcar (lambda (it) (- it atom)) list))
+
+
+(defun find-dups_oml (liste)
+(car
+(remove nil
+(mapcar #'(lambda (l c) (eq l c)) liste (cdr liste)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;end ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
--
Gitblit v1.9.1