SymProg/OM-Lead.git

			@@ -9,15 +9,84 @@
			(in-package :omlead)


			(om::defmethod! gen-harmonies ((pitch-set-list list) (instr1 list) (instr2 list) (instr3 list) (instr4 list) &key (avoid-empty-voices nil) (fundamental 6000) (skala (list 100)) (permutations nil) (register-list '(0)))
			(om::defmethod! gen-harmonies ((pitch-set-list list) (instr1 list) (instr2 list) (instr3 list) (instr4 list) &key (avoid-empty-voices nil) (fundamental 6000) (skala (list 100)) (permutations nil) (register-list '(0)) (avoid-doublings nil))

			:icon 030719972
			:initvals '('((0)) '(6000 7200) nil nil nil)
			:indoc '("a list of lists of intervals respective to a base not in midi-cents" "range-list with the lowest and highest note of the instrument in midi-cents" "range-list with the lowest and highest note of the instrument in midi-cents" "range-list with the lowest and highest note of the instrument in midi-cents" "range-list with the lowest and highest note of the instrument in midi-cents" "list of intervals based on the virtual fundamental which defines the <octave> for register-transposition")
			:indoc '("a list of lists of intervals respective to a base not in midi-cents" "range-list with the lowest and highest note of the instrument in midi-cents" "range-list with the lowest and highest note of the instrument in midi-cents" "range-list with the lowest and highest note of the instrument in midi-cents" "range-list with the lowest and highest note of the instrument in midi-cents" "list of intervals based on the virtual fundamental which defines the <octave> for register-transposition" "if true all chords with the same note in two or more instruments will be avoided")

			:numouts 1

			:doc "creates a list of chords, that contains all possible transpositions & permutations of the given pitch-sets"

			(let* (

			(instr-list (sort (flat_oml (remove nil (list instr1 instr2 instr3 instr4))) '<))
			(total-range (cons (car instr-list) (last instr-list)))
			(trans-skala (let* ((grundton fundamental)
			(tief (car total-range))
			(hoch (cadr total-range))
			(skala-up skala)
			(skala-down (reverse skala-up))
			(endless-up (circular_oml skala-up))
			(endless-down (circular_oml skala-down))
			(skala-up (loop for i in endless-up
			sum i into delta
			until (> (+ delta grundton) hoch)
			collect i))
			(skala-down (loop for i in endless-down
			sum i into delta
			until (< (- grundton delta) tief)
			collect i))
			(transpositionsliste-up (list grundton))
			(transpositionsliste-down (list grundton)))

			(loop for i in skala-up
			do (push (+ (car transpositionsliste-up) i) transpositionsliste-up))
			(loop for i in skala-down
			do (push (- (car transpositionsliste-down) i) transpositionsliste-down))

			(append (butlast transpositionsliste-down) (reverse transpositionsliste-up))
			))

			(harmon-database (om::flat
			(loop for pitch in trans-skala
			collect
			(loop for set in pitch-set-list
			collect
			(mapcar #'(lambda (l) (+ pitch l)) set))) 1))

			(harmon-database (cond (permutations (om::flat (loop for l in harmon-database
			collect (permutations_oml l)) 1))
			(t harmon-database)))


			(harmon-database (remove-duplicates (om::flat (loop for a in harmon-database
			collect
			(loop for reg in (variations_oml register-list (length a))
			collect (mapcar #'(lambda (r p) (+ r p)) reg a))) 1) :test 'equal))

			(harmon-database (cond
			(avoid-doublings (remove nil (loop for a in harmon-database
			collect (if (not (find-dups_oml a)) a nil))))
			(t harmon-database)
			))



			(instr-list2 (list instr1 instr2 instr3 instr4))
			(harmon-database (remove -1 (loop for a in harmon-database
			collect (loop for p in a
			for c to (1- (length instr-list2))

			collect (if (nth c instr-list2) (if (or (< p (car (nth c instr-list2)))
			(> p (cadr (nth c instr-list2)))) nil p) -1)) )))
			(harmon-database (remove nil (loop for a in harmon-database
			collect (if (> (count nil a) 0) nil a))))

			(harmon-database (if avoid-empty-voices (mapcar (lambda (x) (remove -1 x)) harmon-database) harmon-database)))
			harmon-database))

			;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

			(defun circular_oml (items)
			@@ -66,14 +135,6 @@
			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)
			@@ -111,67 +172,14 @@
			(liste (make-list pcl :initial-element liste)))
			(apply #'alexandria:map-product #'list liste)))


			(defun find-dups_oml (lst)
			(cond ((null lst) '())
			((member (car lst) (cdr lst)) (cons (car lst) (find-dups_oml (cdr lst))))
			(t (find-dups_oml (cdr lst)))))

			;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
			(let* (

			(instr-list (sort (flat_oml (remove nil (list instr1 instr2 instr3 instr4))) '<))
			(total-range (cons (car instr-list) (last instr-list)))
			(trans-skala (let* ((grundton fundamental)
			(tief (car total-range))
			(hoch (cadr total-range))
			(skala-up skala)
			(skala-down (reverse skala-up))
			(endless-up (circular_oml skala-up))
			(endless-down (circular_oml skala-down))
			(skala-up (loop for i in endless-up
			sum i into delta
			until (> (+ delta grundton) hoch)
			collect i))
			(skala-down (loop for i in endless-down
			sum i into delta
			until (< (- grundton delta) tief)
			collect i))
			(transpositionsliste-up (list grundton))
			(transpositionsliste-down (list grundton)))

			(loop for i in skala-up
			do (push (+ (car transpositionsliste-up) i) transpositionsliste-up))
			(loop for i in skala-down
			do (push (- (car transpositionsliste-down) i) transpositionsliste-down))

			(append (butlast transpositionsliste-down) (reverse transpositionsliste-up))
			))

			(harmon-database (om::flat
			(loop for pitch in trans-skala
			collect
			(loop for set in pitch-set-list
			collect
			(mapcar #'(lambda (l) (+ pitch l)) set))) 1))

			(harmon-database (cond (permutations (om::flat (loop for l in harmon-database
			collect (permutations_oml l)) 1))
			(t harmon-database)))


			(harmon-database (remove-duplicates (om::flat (loop for a in harmon-database
			collect
			(loop for reg in (variations_oml register-list (length a))
			collect (mapcar #'(lambda (r p) (+ r p)) reg a))) 1) :test 'equal))
			(instr-list2 (list instr1 instr2 instr3 instr4))
			(harmon-database (remove -1 (loop for a in harmon-database
			collect (loop for p in a
			for c to (1- (length instr-list2))

			collect (if (nth c instr-list2) (if (or (< p (car (nth c instr-list2)))
			(> p (cadr (nth c instr-list2)))) nil p) -1)) )))
			(harmon-database (remove nil (loop for a in harmon-database
			collect (if (> (count nil a) 0) nil a))))

			(harmon-database (if avoid-empty-voices (mapcar (lambda (x) (remove -1 x)) harmon-database) harmon-database)))
			harmon-database))


			;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;end;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;