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 +++++++++++++++++++------------------ 1 files changed, 39 insertions(+), 36 deletions(-) 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