| File was renamed from sources/harmon-progress.lisp |
| | |
|---|
| | | |
|---|
| | | (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) |
|---|
| | | (om::defmethod! gen-sequence (harmonies first-harmony number-of-harmonies &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) |
|---|
| | | |
|---|
| | | :icon 030719972 |
|---|
| | | |
|---|
| | |
|---|
| | | |
|---|
| | | |
|---|
| | | |
|---|
| | | (let* ((harmon-database harmon-database) |
|---|
| | | (database (cond (base-list (loop repeat (1- chordnumber) |
|---|
| | | (let* ((harmon-database harmonies) |
|---|
| | | (database (cond (base-list (loop repeat (1- number-of-harmonies) |
|---|
| | | for x in (circular_oml base-list) |
|---|
| | | collect (nth (1- x) harmon-database))) |
|---|
| | | |
|---|
| | | (t (loop repeat (1- chordnumber) collect harmon-database)))) |
|---|
| | | (t (loop repeat (1- number-of-harmonies) collect harmon-database)))) |
|---|
| | | |
|---|
| | | |
|---|
| | | |
|---|
| | | |
|---|
| | | |
|---|
| | | (external-list '())) |
|---|
| | | (append (list first-chord) |
|---|
| | | (loop repeat (- chordnumber 1) |
|---|
| | | (append (list first-harmony) |
|---|
| | | (loop repeat (- number-of-harmonies 1) |
|---|
| | | for database in database |
|---|
| | | |
|---|
| | | for voice-tie1 in (cond ((atom voice-tie1) (loop repeat chordnumber collect voice-tie1)) |
|---|
| | | ((< (length voice-tie1) chordnumber) |
|---|
| | | (append voice-tie1 (loop repeat (- chordnumber (length voice-tie1)) collect (car (reverse voice-tie1))))) |
|---|
| | | for voice-tie1 in (cond ((atom voice-tie1) (loop repeat number-of-harmonies collect voice-tie1)) |
|---|
| | | ((< (length voice-tie1) number-of-harmonies) |
|---|
| | | (append voice-tie1 (loop repeat (- number-of-harmonies (length voice-tie1)) collect (car (reverse voice-tie1))))) |
|---|
| | | (t voice-tie1)) |
|---|
| | | for voice-tie2 in (cond ((atom voice-tie2) (loop repeat chordnumber collect voice-tie2)) |
|---|
| | | ((< (length voice-tie2) chordnumber) |
|---|
| | | (append voice-tie2 (loop repeat (- chordnumber (length voice-tie2)) collect (car (reverse voice-tie2))))) |
|---|
| | | for voice-tie2 in (cond ((atom voice-tie2) (loop repeat number-of-harmonies collect voice-tie2)) |
|---|
| | | ((< (length voice-tie2) number-of-harmonies) |
|---|
| | | (append voice-tie2 (loop repeat (- number-of-harmonies (length voice-tie2)) collect (car (reverse voice-tie2))))) |
|---|
| | | (t voice-tie2)) |
|---|
| | | for voice-tie3 in (cond ((atom voice-tie3) (loop repeat chordnumber collect voice-tie3)) |
|---|
| | | ((< (length voice-tie3) chordnumber) |
|---|
| | | (append voice-tie3 (loop repeat (- chordnumber (length voice-tie3)) collect (car (reverse voice-tie3))))) |
|---|
| | | for voice-tie3 in (cond ((atom voice-tie3) (loop repeat number-of-harmonies collect voice-tie3)) |
|---|
| | | ((< (length voice-tie3) number-of-harmonies) |
|---|
| | | (append voice-tie3 (loop repeat (- number-of-harmonies (length voice-tie3)) collect (car (reverse voice-tie3))))) |
|---|
| | | (t voice-tie3)) |
|---|
| | | for voice-tie4 in (cond ((atom voice-tie4) (loop repeat chordnumber collect voice-tie4)) |
|---|
| | | ((< (length voice-tie4) chordnumber) |
|---|
| | | (append voice-tie4 (loop repeat (- chordnumber (length voice-tie4)) collect (car (reverse voice-tie4))))) |
|---|
| | | for voice-tie4 in (cond ((atom voice-tie4) (loop repeat number-of-harmonies collect voice-tie4)) |
|---|
| | | ((< (length voice-tie4) number-of-harmonies) |
|---|
| | | (append voice-tie4 (loop repeat (- number-of-harmonies (length voice-tie4)) collect (car (reverse voice-tie4))))) |
|---|
| | | (t voice-tie4)) |
|---|
| | | |
|---|
| | | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
|---|
| | | for voice-interval1 in (cond ((atom (car voice-interval1)) (loop repeat chordnumber collect voice-interval1)) |
|---|
| | | ((< (length voice-interval1) chordnumber) |
|---|
| | | (append voice-interval1 (loop repeat (- chordnumber (length voice-interval1)) collect (car (reverse voice-interval1))))) |
|---|
| | | for voice-interval1 in (cond ((atom (car voice-interval1)) (loop repeat number-of-harmonies collect voice-interval1)) |
|---|
| | | ((< (length voice-interval1) number-of-harmonies) |
|---|
| | | (append voice-interval1 (loop repeat (- number-of-harmonies (length voice-interval1)) collect (car (reverse voice-interval1))))) |
|---|
| | | (t voice-interval1)) |
|---|
| | | for voice-interval2 in (cond ((atom (car voice-interval2)) (loop repeat chordnumber collect voice-interval2)) |
|---|
| | | ((< (length voice-interval2) chordnumber) |
|---|
| | | (append voice-interval2 (loop repeat (- chordnumber (length voice-interval2)) collect (car (reverse voice-interval2))))) |
|---|
| | | for voice-interval2 in (cond ((atom (car voice-interval2)) (loop repeat number-of-harmonies collect voice-interval2)) |
|---|
| | | ((< (length voice-interval2) number-of-harmonies) |
|---|
| | | (append voice-interval2 (loop repeat (- number-of-harmonies (length voice-interval2)) collect (car (reverse voice-interval2))))) |
|---|
| | | (t voice-interval2)) |
|---|
| | | for voice-interval3 in (cond ((atom (car voice-interval3)) (loop repeat chordnumber collect voice-interval3)) |
|---|
| | | ((< (length voice-interval3) chordnumber) |
|---|
| | | (append voice-interval3 (loop repeat (- chordnumber (length voice-interval3)) collect (car (reverse voice-interval3))))) |
|---|
| | | for voice-interval3 in (cond ((atom (car voice-interval3)) (loop repeat number-of-harmonies collect voice-interval3)) |
|---|
| | | ((< (length voice-interval3) number-of-harmonies) |
|---|
| | | (append voice-interval3 (loop repeat (- number-of-harmonies (length voice-interval3)) collect (car (reverse voice-interval3))))) |
|---|
| | | (t voice-interval3)) |
|---|
| | | for voice-interval4 in (cond ((atom (car voice-interval4)) (loop repeat chordnumber collect voice-interval4)) |
|---|
| | | ((< (length voice-interval4) chordnumber) |
|---|
| | | (append voice-interval4 (loop repeat (- chordnumber (length voice-interval4)) collect (car (reverse voice-interval4))))) |
|---|
| | | for voice-interval4 in (cond ((atom (car voice-interval4)) (loop repeat number-of-harmonies collect voice-interval4)) |
|---|
| | | ((< (length voice-interval4) number-of-harmonies) |
|---|
| | | (append voice-interval4 (loop repeat (- number-of-harmonies (length voice-interval4)) collect (car (reverse voice-interval4))))) |
|---|
| | | (t voice-interval4)) |
|---|
| | | |
|---|
| | | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
|---|
| | | for voice-counter1 in (if (eq nil voice-counter1) (loop repeat chordnumber collect nil) |
|---|
| | | for voice-counter1 in (if (eq nil voice-counter1) (loop repeat number-of-harmonies collect nil) |
|---|
| | | |
|---|
| | | (mat-trans_oml (list (cond ((not (listp (caar voice-counter1))) (loop repeat chordnumber collect (car voice-counter1))) |
|---|
| | | ((< (length (car voice-counter1)) chordnumber) |
|---|
| | | (append (car voice-counter1) (loop repeat (- chordnumber (length (car voice-counter1))) |
|---|
| | | (mat-trans_oml (list (cond ((not (listp (caar voice-counter1))) (loop repeat number-of-harmonies collect (car voice-counter1))) |
|---|
| | | ((< (length (car voice-counter1)) number-of-harmonies) |
|---|
| | | (append (car voice-counter1) (loop repeat (- number-of-harmonies (length (car voice-counter1))) |
|---|
| | | collect (car (reverse (car voice-counter1)))))) |
|---|
| | | (t (car voice-counter1))) |
|---|
| | | (cond ((< (length (cadr voice-counter1)) chordnumber) |
|---|
| | | (append (cadr voice-counter1) (loop repeat (- chordnumber (length (cadr voice-counter1))) |
|---|
| | | (cond ((< (length (cadr voice-counter1)) number-of-harmonies) |
|---|
| | | (append (cadr voice-counter1) (loop repeat (- number-of-harmonies (length (cadr voice-counter1))) |
|---|
| | | collect (car (reverse (cadr voice-counter1)))))) |
|---|
| | | (t (cadr voice-counter1)))))) |
|---|
| | | for voice-counter2 in (if (eq nil voice-counter2) (loop repeat chordnumber collect nil) |
|---|
| | | for voice-counter2 in (if (eq nil voice-counter2) (loop repeat number-of-harmonies collect nil) |
|---|
| | | |
|---|
| | | (mat-trans_oml (list (cond ((not (listp (caar voice-counter2))) (loop repeat chordnumber collect (car voice-counter2))) |
|---|
| | | ((< (length (car voice-counter2)) chordnumber) |
|---|
| | | (append (car voice-counter2) (loop repeat (- chordnumber (length (car voice-counter2))) |
|---|
| | | (mat-trans_oml (list (cond ((not (listp (caar voice-counter2))) (loop repeat number-of-harmonies collect (car voice-counter2))) |
|---|
| | | ((< (length (car voice-counter2)) number-of-harmonies) |
|---|
| | | (append (car voice-counter2) (loop repeat (- number-of-harmonies (length (car voice-counter2))) |
|---|
| | | collect (car (reverse (car voice-counter2)))))) |
|---|
| | | (t (car voice-counter2))) |
|---|
| | | (cond ((< (length (cadr voice-counter2)) chordnumber) |
|---|
| | | (append (cadr voice-counter2) (loop repeat (- chordnumber (length (cadr voice-counter2))) |
|---|
| | | (cond ((< (length (cadr voice-counter2)) number-of-harmonies) |
|---|
| | | (append (cadr voice-counter2) (loop repeat (- number-of-harmonies (length (cadr voice-counter2))) |
|---|
| | | collect (car (reverse (cadr voice-counter2)))))) |
|---|
| | | (t (cadr voice-counter2)))))) |
|---|
| | | for voice-counter3 in (if (eq nil voice-counter3) (loop repeat chordnumber collect nil) |
|---|
| | | for voice-counter3 in (if (eq nil voice-counter3) (loop repeat number-of-harmonies collect nil) |
|---|
| | | |
|---|
| | | (mat-trans_oml (list (cond ((not (listp (caar voice-counter3))) (loop repeat chordnumber collect (car voice-counter3))) |
|---|
| | | ((< (length (car voice-counter3)) chordnumber) |
|---|
| | | (append (car voice-counter3) (loop repeat (- chordnumber (length (car voice-counter3))) |
|---|
| | | (mat-trans_oml (list (cond ((not (listp (caar voice-counter3))) (loop repeat number-of-harmonies collect (car voice-counter3))) |
|---|
| | | ((< (length (car voice-counter3)) number-of-harmonies) |
|---|
| | | (append (car voice-counter3) (loop repeat (- number-of-harmonies (length (car voice-counter3))) |
|---|
| | | collect (car (reverse (car voice-counter3)))))) |
|---|
| | | (t (car voice-counter3))) |
|---|
| | | (cond ((< (length (cadr voice-counter3)) chordnumber) |
|---|
| | | (append (cadr voice-counter3) (loop repeat (- chordnumber (length (cadr voice-counter3))) |
|---|
| | | (cond ((< (length (cadr voice-counter3)) number-of-harmonies) |
|---|
| | | (append (cadr voice-counter3) (loop repeat (- number-of-harmonies (length (cadr voice-counter3))) |
|---|
| | | collect (car (reverse (cadr voice-counter3)))))) |
|---|
| | | (t (cadr voice-counter3)))))) |
|---|
| | | for voice-counter4 in (if (eq nil voice-counter4) (loop repeat chordnumber collect nil) |
|---|
| | | for voice-counter4 in (if (eq nil voice-counter4) (loop repeat number-of-harmonies collect nil) |
|---|
| | | |
|---|
| | | (mat-trans_oml (list (cond ((not (listp (caar voice-counter4))) (loop repeat chordnumber collect (car voice-counter4))) |
|---|
| | | ((< (length (car voice-counter4)) chordnumber) |
|---|
| | | (append (car voice-counter4) (loop repeat (- chordnumber (length (car voice-counter4))) |
|---|
| | | (mat-trans_oml (list (cond ((not (listp (caar voice-counter4))) (loop repeat number-of-harmonies collect (car voice-counter4))) |
|---|
| | | ((< (length (car voice-counter4)) number-of-harmonies) |
|---|
| | | (append (car voice-counter4) (loop repeat (- number-of-harmonies (length (car voice-counter4))) |
|---|
| | | collect (car (reverse (car voice-counter4)))))) |
|---|
| | | (t (car voice-counter4))) |
|---|
| | | (cond ((< (length (cadr voice-counter4)) chordnumber) |
|---|
| | | (append (cadr voice-counter4) (loop repeat (- chordnumber (length (cadr voice-counter4))) |
|---|
| | | (cond ((< (length (cadr voice-counter4)) number-of-harmonies) |
|---|
| | | (append (cadr voice-counter4) (loop repeat (- number-of-harmonies (length (cadr voice-counter4))) |
|---|
| | | collect (car (reverse (cadr voice-counter4)))))) |
|---|
| | | (t (cadr voice-counter4)))))) |
|---|
| | | for voice-counter5 in (if (eq nil voice-counter5) (loop repeat chordnumber collect nil) |
|---|
| | | for voice-counter5 in (if (eq nil voice-counter5) (loop repeat number-of-harmonies collect nil) |
|---|
| | | |
|---|
| | | (mat-trans_oml (list (cond ((not (listp (caar voice-counter5))) (loop repeat chordnumber collect (car voice-counter5))) |
|---|
| | | ((< (length (car voice-counter5)) chordnumber) |
|---|
| | | (append (car voice-counter5) (loop repeat (- chordnumber (length (car voice-counter5))) |
|---|
| | | (mat-trans_oml (list (cond ((not (listp (caar voice-counter5))) (loop repeat number-of-harmonies collect (car voice-counter5))) |
|---|
| | | ((< (length (car voice-counter5)) number-of-harmonies) |
|---|
| | | (append (car voice-counter5) (loop repeat (- number-of-harmonies (length (car voice-counter5))) |
|---|
| | | collect (car (reverse (car voice-counter5)))))) |
|---|
| | | (t (car voice-counter5))) |
|---|
| | | (cond ((< (length (cadr voice-counter5)) chordnumber) |
|---|
| | | (append (cadr voice-counter5) (loop repeat (- chordnumber (length (cadr voice-counter5))) |
|---|
| | | (cond ((< (length (cadr voice-counter5)) number-of-harmonies) |
|---|
| | | (append (cadr voice-counter5) (loop repeat (- number-of-harmonies (length (cadr voice-counter5))) |
|---|
| | | collect (car (reverse (cadr voice-counter5)))))) |
|---|
| | | (t (cadr voice-counter5)))))) |
|---|
| | | for voice-counter6 in (if (eq nil voice-counter6) (loop repeat chordnumber collect nil) |
|---|
| | | for voice-counter6 in (if (eq nil voice-counter6) (loop repeat number-of-harmonies collect nil) |
|---|
| | | |
|---|
| | | (mat-trans_oml (list (cond ((not (listp (caar voice-counter6))) (loop repeat chordnumber collect (car voice-counter6))) |
|---|
| | | ((< (length (car voice-counter6)) chordnumber) |
|---|
| | | (append (car voice-counter6) (loop repeat (- chordnumber (length (car voice-counter6))) |
|---|
| | | (mat-trans_oml (list (cond ((not (listp (caar voice-counter6))) (loop repeat number-of-harmonies collect (car voice-counter6))) |
|---|
| | | ((< (length (car voice-counter6)) number-of-harmonies) |
|---|
| | | (append (car voice-counter6) (loop repeat (- number-of-harmonies (length (car voice-counter6))) |
|---|
| | | collect (car (reverse (car voice-counter6)))))) |
|---|
| | | (t (car voice-counter6))) |
|---|
| | | (cond ((< (length (cadr voice-counter6)) chordnumber) |
|---|
| | | (append (cadr voice-counter6) (loop repeat (- chordnumber (length (cadr voice-counter6))) |
|---|
| | | (cond ((< (length (cadr voice-counter6)) number-of-harmonies) |
|---|
| | | (append (cadr voice-counter6) (loop repeat (- number-of-harmonies (length (cadr voice-counter6))) |
|---|
| | | collect (car (reverse (cadr voice-counter6)))))) |
|---|
| | | (t (cadr voice-counter6)))))) |
|---|
| | | |
|---|
| | | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
|---|
| | | for counter-interval1 in (cond ((atom (car counter-interval1)) (loop repeat chordnumber collect counter-interval1)) |
|---|
| | | ((< (length counter-interval1) chordnumber) |
|---|
| | | (append counter-interval1 (loop repeat (- chordnumber (length counter-interval1)) collect (car (reverse counter-interval1))))) |
|---|
| | | for counter-interval1 in (cond ((atom (car counter-interval1)) (loop repeat number-of-harmonies collect counter-interval1)) |
|---|
| | | ((< (length counter-interval1) number-of-harmonies) |
|---|
| | | (append counter-interval1 (loop repeat (- number-of-harmonies (length counter-interval1)) collect (car (reverse counter-interval1))))) |
|---|
| | | (t counter-interval1)) |
|---|
| | | for counter-interval2 in (cond ((atom (car counter-interval2)) (loop repeat chordnumber collect counter-interval2)) |
|---|
| | | ((< (length counter-interval2) chordnumber) |
|---|
| | | (append counter-interval2 (loop repeat (- chordnumber (length counter-interval2)) collect (car (reverse counter-interval2))))) |
|---|
| | | for counter-interval2 in (cond ((atom (car counter-interval2)) (loop repeat number-of-harmonies collect counter-interval2)) |
|---|
| | | ((< (length counter-interval2) number-of-harmonies) |
|---|
| | | (append counter-interval2 (loop repeat (- number-of-harmonies (length counter-interval2)) collect (car (reverse counter-interval2))))) |
|---|
| | | (t counter-interval2)) |
|---|
| | | for counter-interval3 in (cond ((atom (car counter-interval3)) (loop repeat chordnumber collect counter-interval3)) |
|---|
| | | ((< (length counter-interval3) chordnumber) |
|---|
| | | (append counter-interval3 (loop repeat (- chordnumber (length counter-interval3)) collect (car (reverse counter-interval3))))) |
|---|
| | | for counter-interval3 in (cond ((atom (car counter-interval3)) (loop repeat number-of-harmonies collect counter-interval3)) |
|---|
| | | ((< (length counter-interval3) number-of-harmonies) |
|---|
| | | (append counter-interval3 (loop repeat (- number-of-harmonies (length counter-interval3)) collect (car (reverse counter-interval3))))) |
|---|
| | | (t counter-interval3)) |
|---|
| | | for counter-interval4 in (cond ((atom (car counter-interval4)) (loop repeat chordnumber collect counter-interval4)) |
|---|
| | | ((< (length counter-interval4) chordnumber) |
|---|
| | | (append counter-interval4 (loop repeat (- chordnumber (length counter-interval4)) collect (car (reverse counter-interval4))))) |
|---|
| | | for counter-interval4 in (cond ((atom (car counter-interval4)) (loop repeat number-of-harmonies collect counter-interval4)) |
|---|
| | | ((< (length counter-interval4) number-of-harmonies) |
|---|
| | | (append counter-interval4 (loop repeat (- number-of-harmonies (length counter-interval4)) collect (car (reverse counter-interval4))))) |
|---|
| | | (t counter-interval4)) |
|---|
| | | for counter-interval5 in (cond ((atom (car counter-interval5)) (loop repeat chordnumber collect counter-interval5)) |
|---|
| | | ((< (length counter-interval5) chordnumber) |
|---|
| | | (append counter-interval5 (loop repeat (- chordnumber (length counter-interval5)) collect (car (reverse counter-interval5))))) |
|---|
| | | for counter-interval5 in (cond ((atom (car counter-interval5)) (loop repeat number-of-harmonies collect counter-interval5)) |
|---|
| | | ((< (length counter-interval5) number-of-harmonies) |
|---|
| | | (append counter-interval5 (loop repeat (- number-of-harmonies (length counter-interval5)) collect (car (reverse counter-interval5))))) |
|---|
| | | (t counter-interval5)) |
|---|
| | | for counter-interval6 in (cond ((atom (car counter-interval6)) (loop repeat chordnumber collect counter-interval6)) |
|---|
| | | ((< (length counter-interval6) chordnumber) |
|---|
| | | (append counter-interval6 (loop repeat (- chordnumber (length counter-interval6)) collect (car (reverse counter-interval6))))) |
|---|
| | | for counter-interval6 in (cond ((atom (car counter-interval6)) (loop repeat number-of-harmonies collect counter-interval6)) |
|---|
| | | ((< (length counter-interval6) number-of-harmonies) |
|---|
| | | (append counter-interval6 (loop repeat (- number-of-harmonies (length counter-interval6)) collect (car (reverse counter-interval6))))) |
|---|
| | | (t counter-interval6)) |
|---|
| | | |
|---|
| | | |
|---|
| | |
|---|
| | | |
|---|
| | | |
|---|
| | | collect |
|---|
| | | (let* ((second (nconc (list first-chord) external-list)) |
|---|
| | | (let* ((second (nconc (list first-harmony) external-list)) |
|---|
| | | (first (car (last second)));6000 6700 |
|---|
| | | (second (let* ((temp-base database) |
|---|
| | | |
|---|
