;======================================
|
;OM-Lead, 2022-2023
|
;
|
;Library for Rule-based Voice-Leading
|
;Author: Lorenz Lehmann
|
;Supervision: Marlon Schumacher
|
;======================================
|
|
(in-package :om)
|
|
(defmethod! rhythmic-progress (harmon-progress randomize measure tempo legato &key raster0 raster1 raster2 raster3)
|
|
:doc "Gives the possibility of rhythmic and melodic movement between the chords"
|
:indoc '("chord-list from harmon-progress" "t: permutates randomly the rhythmic-order " "measure" "tempo" "legato" "(voice-number (smallest rhythmic value, should be a fraction & stepsize, an intervall in midicents))" "(voice-number (smallest rhythmic value, should be a fraction & stepsize, an intervall in midicents))" "(voice-number (smallest rhythmic value, should be a fraction & stepsize, an intervall in midicents))" "(voice-number (smallest rhythmic value, should be a fraction & stepsize, an intervall in midicents))")
|
:icon 030719971
|
:numouts 1
|
|
;xxxxxxxxxxxxxxxxxxxxxxxx
|
|
;xxxxxxxxxxxxxxxxxxxxxxxx
|
(reverse (remove nil (list
|
|
(cond
|
|
((and (not (eq raster0 'nil))
|
(or (eq (car (nth (car raster0) (mat-trans harmon-progress))) 'nil)
|
(eq (cadr (nth (car raster0) (mat-trans harmon-progress))) 'nil)
|
(eq (car (nth (car raster0) (mat-trans harmon-progress))) (cadr (nth (car raster0) (mat-trans harmon-progress))))))
|
|
(let ((pitch-list (nth (car raster0) (mat-trans harmon-progress))))
|
(let ((note (car pitch-list)))
|
|
(make-instance 'voice
|
:tree (list '? (if (eq note nil) (list (list (append measure) '(-1))) (list (list (append measure) '(1)))))
|
:tempo tempo
|
:legato legato
|
:chords (list note)))
|
|
))
|
|
((and (not (eq raster0 'nil))
|
|
(let
|
((pulsation (cadr (cadr raster0)))
|
(pitch-list (nth (car raster0) (mat-trans harmon-progress))))
|
(let
|
((interval (- (cadr pitch-list) (car pitch-list))))
|
(let
|
((delta (if (> 0 interval) (* -1 interval) interval))
|
(stepsize (caadr raster0)))
|
(>
|
(* (car (multiple-value-list (floor delta stepsize))) pulsation)
|
(/ (car measure) (cadr measure)))))))
|
|
(let
|
((pulsation (cadr (cadr raster0)))
|
(pitch-list (nth (car raster0) (mat-trans harmon-progress))))
|
(let
|
((interval (- (cadr pitch-list) (car pitch-list))))
|
(let
|
((delta (if (> 0 interval) (* -1 interval) interval))
|
(stepsize (caadr raster0)))
|
(let
|
((step (if (> 0 interval) (* -1 stepsize) stepsize)))
|
(let
|
((chord-list (dx->x (car pitch-list)
|
(make-list (car (multiple-value-list (floor delta stepsize))) :initial-element step))))
|
(let ((final-chords
|
(append (list (car pitch-list)) (nthcdr (/ (- (* (length chord-list) pulsation) (/ (car measure) (cadr measure))) pulsation) (butlast chord-list)))))
|
|
(make-instance 'voice
|
:tree (list '? (list (list (append measure) (make-list (car measure) :initial-element 1))))
|
:tempo tempo
|
:legato legato
|
:chords final-chords
|
|
|
|
|
|
))))))))
|
|
|
|
|
(raster0
|
(let
|
(
|
(pitch-list (nth (car raster0) (mat-trans harmon-progress)))
|
(pulsation (cadr (cadr raster0)))
|
(stepsize (caadr raster0))
|
)
|
|
(let ((interval (- (cadr pitch-list) (car pitch-list))))
|
(let ((delta (if (> 0 interval) (* -1 interval) interval)))
|
|
|
(let
|
((chord-list
|
(let ((step (if (< (car pitch-list) (cadr pitch-list)) stepsize (* -1 stepsize))))
|
(butlast (dx->x (car pitch-list) (remove nil (append (make-list (car (multiple-value-list
|
|
(floor delta stepsize))) :initial-element step)
|
(if (= 0 (cadr (multiple-value-list (floor delta stepsize))))
|
(list nil)
|
(if (< step 0)
|
(list (* -1 (cadr (multiple-value-list (floor delta stepsize)))))
|
(list (cadr (multiple-value-list (floor delta stepsize)))))
|
))))))))
|
|
(let
|
|
((rhythm-list (if (values randomize)
|
(permut-random (append
|
(list (- 1 (* (- (length chord-list) 1) pulsation)))
|
(make-list (- (length chord-list) 1) :initial-element pulsation)))
|
(append
|
(list (- 1 (* (- (length chord-list) 1) pulsation)))
|
(make-list (- (length chord-list) 1) :initial-element pulsation))
|
))
|
|
|
|
)
|
|
(make-instance 'voice
|
:tree (mktree rhythm-list measure)
|
:tempo tempo
|
:legato legato
|
:chords chord-list)
|
|
))))))
|
(t nil))
|
|
;;;raster1;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(cond
|
|
((and (not (eq raster1 'nil))
|
(or (eq (car (nth (car raster1) (mat-trans harmon-progress))) 'nil)
|
(eq (cadr (nth (car raster1) (mat-trans harmon-progress))) 'nil)
|
(eq (car (nth (car raster1) (mat-trans harmon-progress))) (cadr (nth (car raster1) (mat-trans harmon-progress))))))
|
|
(let ((pitch-list (nth (car raster1) (mat-trans harmon-progress))))
|
(let ((note (car pitch-list)))
|
|
(make-instance 'voice
|
:tree (list '? (if (eq note nil) (list (list (append measure) '(-1))) (list (list (append measure) '(1)))))
|
:tempo tempo
|
:legato legato
|
:chords (list note)))
|
|
))
|
|
((and (not (eq raster1 'nil))
|
|
(let
|
((pulsation (cadr (cadr raster1)))
|
(pitch-list (nth (car raster1) (mat-trans harmon-progress))))
|
(let
|
((interval (- (cadr pitch-list) (car pitch-list))))
|
(let
|
((delta (if (> 0 interval) (* -1 interval) interval))
|
(stepsize (caadr raster1)))
|
(>
|
(* (car (multiple-value-list (floor delta stepsize))) pulsation)
|
(/ (car measure) (cadr measure)))))))
|
|
(let
|
((pulsation (cadr (cadr raster1)))
|
(pitch-list (nth (car raster1) (mat-trans harmon-progress))))
|
(let
|
((interval (- (cadr pitch-list) (car pitch-list))))
|
(let
|
((delta (if (> 0 interval) (* -1 interval) interval))
|
(stepsize (caadr raster1)))
|
(let
|
((step (if (> 0 interval) (* -1 stepsize) stepsize)))
|
(let
|
((chord-list (dx->x (car pitch-list)
|
(make-list (car (multiple-value-list (floor delta stepsize))) :initial-element step))))
|
(let ((final-chords
|
(append (list (car pitch-list)) (nthcdr (/ (- (* (length chord-list) pulsation) (/ (car measure) (cadr measure))) pulsation) (butlast chord-list)))))
|
|
(make-instance 'voice
|
:tree (list '? (list (list (append measure) (make-list (car measure) :initial-element 1))))
|
:tempo tempo
|
:legato legato
|
:chords final-chords
|
|
|
|
|
|
))))))))
|
|
|
|
|
(raster1
|
(let
|
(
|
(pitch-list (nth (car raster1) (mat-trans harmon-progress)))
|
(pulsation (cadr (cadr raster1)))
|
(stepsize (caadr raster1))
|
)
|
|
(let ((interval (- (cadr pitch-list) (car pitch-list))))
|
(let ((delta (if (> 0 interval) (* -1 interval) interval)))
|
|
|
(let
|
((chord-list
|
(let ((step (if (< (car pitch-list) (cadr pitch-list)) stepsize (* -1 stepsize))))
|
(butlast (dx->x (car pitch-list) (remove nil (append (make-list (car (multiple-value-list
|
|
(floor delta stepsize))) :initial-element step)
|
(if (= 0 (cadr (multiple-value-list (floor delta stepsize))))
|
(list nil)
|
(if (< step 0)
|
(list (* -1 (cadr (multiple-value-list (floor delta stepsize)))))
|
(list (cadr (multiple-value-list (floor delta stepsize)))))
|
))))))))
|
|
(let
|
|
((rhythm-list (if (values randomize)
|
(permut-random (append
|
(list (- 1 (* (- (length chord-list) 1) pulsation)))
|
(make-list (- (length chord-list) 1) :initial-element pulsation)))
|
(append
|
(list (- 1 (* (- (length chord-list) 1) pulsation)))
|
(make-list (- (length chord-list) 1) :initial-element pulsation))
|
))
|
|
|
|
)
|
|
(make-instance 'voice
|
:tree (mktree rhythm-list measure)
|
:tempo tempo
|
:legato legato
|
:chords chord-list)
|
|
))))))
|
(t nil))
|
|
;;;raster2;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(cond
|
|
((and (not (eq raster2 'nil))
|
(or (eq (car (nth (car raster2) (mat-trans harmon-progress))) 'nil)
|
(eq (cadr (nth (car raster2) (mat-trans harmon-progress))) 'nil)
|
(eq (car (nth (car raster2) (mat-trans harmon-progress))) (cadr (nth (car raster2) (mat-trans harmon-progress))))))
|
|
(let ((pitch-list (nth (car raster2) (mat-trans harmon-progress))))
|
(let ((note (car pitch-list)))
|
|
(make-instance 'voice
|
:tree (list '? (if (eq note nil) (list (list (append measure) '(-1))) (list (list (append measure) '(1)))))
|
:tempo tempo
|
:legato legato
|
:chords (list note)))
|
|
))
|
|
((and (not (eq raster2 'nil))
|
|
(let
|
((pulsation (cadr (cadr raster2)))
|
(pitch-list (nth (car raster2) (mat-trans harmon-progress))))
|
(let
|
((interval (- (cadr pitch-list) (car pitch-list))))
|
(let
|
((delta (if (> 0 interval) (* -1 interval) interval))
|
(stepsize (caadr raster2)))
|
(>
|
(* (car (multiple-value-list (floor delta stepsize))) pulsation)
|
(/ (car measure) (cadr measure)))))))
|
|
(let
|
((pulsation (cadr (cadr raster2)))
|
(pitch-list (nth (car raster2) (mat-trans harmon-progress))))
|
(let
|
((interval (- (cadr pitch-list) (car pitch-list))))
|
(let
|
((delta (if (> 0 interval) (* -1 interval) interval))
|
(stepsize (caadr raster2)))
|
(let
|
((step (if (> 0 interval) (* -1 stepsize) stepsize)))
|
(let
|
((chord-list (dx->x (car pitch-list)
|
(make-list (car (multiple-value-list (floor delta stepsize))) :initial-element step))))
|
(let ((final-chords
|
(append (list (car pitch-list)) (nthcdr (/ (- (* (length chord-list) pulsation) (/ (car measure) (cadr measure))) pulsation) (butlast chord-list)))))
|
|
(make-instance 'voice
|
:tree (list '? (list (list (append measure) (make-list (car measure) :initial-element 1))))
|
:tempo tempo
|
:legato legato
|
:chords final-chords
|
|
|
|
|
|
))))))))
|
|
|
|
|
(raster2
|
(let
|
(
|
(pitch-list (nth (car raster2) (mat-trans harmon-progress)))
|
(pulsation (cadr (cadr raster2)))
|
(stepsize (caadr raster2))
|
)
|
|
(let ((interval (- (cadr pitch-list) (car pitch-list))))
|
(let ((delta (if (> 0 interval) (* -1 interval) interval)))
|
|
|
(let
|
((chord-list
|
(let ((step (if (< (car pitch-list) (cadr pitch-list)) stepsize (* -1 stepsize))))
|
(butlast (dx->x (car pitch-list) (remove nil (append (make-list (car (multiple-value-list
|
|
(floor delta stepsize))) :initial-element step)
|
(if (= 0 (cadr (multiple-value-list (floor delta stepsize))))
|
(list nil)
|
(if (< step 0)
|
(list (* -1 (cadr (multiple-value-list (floor delta stepsize)))))
|
(list (cadr (multiple-value-list (floor delta stepsize)))))
|
))))))))
|
|
(let
|
|
((rhythm-list (if (values randomize)
|
(permut-random (append
|
(list (- 1 (* (- (length chord-list) 1) pulsation)))
|
(make-list (- (length chord-list) 1) :initial-element pulsation)))
|
(append
|
(list (- 1 (* (- (length chord-list) 1) pulsation)))
|
(make-list (- (length chord-list) 1) :initial-element pulsation))
|
))
|
|
|
|
)
|
|
(make-instance 'voice
|
:tree (mktree rhythm-list measure)
|
:tempo tempo
|
:legato legato
|
:chords chord-list)
|
|
))))))
|
(t nil))
|
|
;;;raster3;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(cond
|
|
((and (not (eq raster3 'nil))
|
(or (eq (car (nth (car raster3) (mat-trans harmon-progress))) 'nil)
|
(eq (cadr (nth (car raster3) (mat-trans harmon-progress))) 'nil)
|
(eq (car (nth (car raster3) (mat-trans harmon-progress))) (cadr (nth (car raster3) (mat-trans harmon-progress))))))
|
|
(let ((pitch-list (nth (car raster3) (mat-trans harmon-progress))))
|
(let ((note (car pitch-list)))
|
|
(make-instance 'voice
|
:tree (list '? (if (eq note nil) (list (list (append measure) '(-1))) (list (list (append measure) '(1)))))
|
:tempo tempo
|
:legato legato
|
:chords (list note)))
|
|
))
|
|
((and (not (eq raster3 'nil))
|
|
(let
|
((pulsation (cadr (cadr raster3)))
|
(pitch-list (nth (car raster3) (mat-trans harmon-progress))))
|
(let
|
((interval (- (cadr pitch-list) (car pitch-list))))
|
(let
|
((delta (if (> 0 interval) (* -1 interval) interval))
|
(stepsize (caadr raster3)))
|
(>
|
(* (car (multiple-value-list (floor delta stepsize))) pulsation)
|
(/ (car measure) (cadr measure)))))))
|
|
(let
|
((pulsation (cadr (cadr raster3)))
|
(pitch-list (nth (car raster3) (mat-trans harmon-progress))))
|
(let
|
((interval (- (cadr pitch-list) (car pitch-list))))
|
(let
|
((delta (if (> 0 interval) (* -1 interval) interval))
|
(stepsize (caadr raster3)))
|
(let
|
((step (if (> 0 interval) (* -1 stepsize) stepsize)))
|
(let
|
((chord-list (dx->x (car pitch-list)
|
(make-list (car (multiple-value-list (floor delta stepsize))) :initial-element step))))
|
(let ((final-chords
|
(append (list (car pitch-list)) (nthcdr (/ (- (* (length chord-list) pulsation) (/ (car measure) (cadr measure))) pulsation) (butlast chord-list)))))
|
|
(make-instance 'voice
|
:tree (list '? (list (list (append measure) (make-list (car measure) :initial-element 1))))
|
:tempo tempo
|
:legato legato
|
:chords final-chords
|
|
|
|
|
|
))))))))
|
|
|
|
|
(raster3
|
(let
|
(
|
(pitch-list (nth (car raster3) (mat-trans harmon-progress)))
|
(pulsation (cadr (cadr raster3)))
|
(stepsize (caadr raster3))
|
)
|
|
(let ((interval (- (cadr pitch-list) (car pitch-list))))
|
(let ((delta (if (> 0 interval) (* -1 interval) interval)))
|
|
|
(let
|
((chord-list
|
(let ((step (if (< (car pitch-list) (cadr pitch-list)) stepsize (* -1 stepsize))))
|
(butlast (dx->x (car pitch-list) (remove nil (append (make-list (car (multiple-value-list
|
|
(floor delta stepsize))) :initial-element step)
|
(if (= 0 (cadr (multiple-value-list (floor delta stepsize))))
|
(list nil)
|
(if (< step 0)
|
(list (* -1 (cadr (multiple-value-list (floor delta stepsize)))))
|
(list (cadr (multiple-value-list (floor delta stepsize)))))
|
))))))))
|
|
(let
|
|
((rhythm-list (if (values randomize)
|
(permut-random (append
|
(list (- 1 (* (- (length chord-list) 1) pulsation)))
|
(make-list (- (length chord-list) 1) :initial-element pulsation)))
|
(append
|
(list (- 1 (* (- (length chord-list) 1) pulsation)))
|
(make-list (- (length chord-list) 1) :initial-element pulsation))
|
))
|
|
|
|
)
|
|
(make-instance 'voice
|
:tree (mktree rhythm-list measure)
|
:tempo tempo
|
:legato legato
|
:chords chord-list)
|
|
))))))
|
(t nil))
|
|
;;;end;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
))))
|
;;;end;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
