;====================================== ;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;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;