Posted May 29, 20177 yr here is a first version => replaces a PITCH by a sequence - overwriting the "old seq" - not very easy to CODE/understand how to do it :-) take a look an perhaps you have some more/better/extending ideas... a better way to solve the problems? greetings andré ;;; -------------------------------------------------------------------------------------------- ;;; FUNCTIONS ;;; -------------------------------------------------------------------------------------------- (defun get-resolution (seq pattern) (let ((val)) (progn (setq val (loop for i in (single-events seq) when (pattern-matchp i pattern) collect (denominator (car (omn :length i))))) (cond ((memberp (car val) '(3 6 12 24 48)) 1/24) ((memberp (car val) '(2 4 8 16 32)) 1/16) ((memberp (car val) '(5 10 20 40)) 1/20) ((memberp (car val) '(7 14 28 56)) 1/28))))) (defun replace-pitch-by-sequence (seq pitch insert) (let ((resolution (get-resolution seq pitch))) (omn-merge-ties (flatten (loop repeat (length (omn-to-time-signature seq (list (numerator resolution) (denominator resolution)))) for cnt = 0 then (incf cnt) with new-seq = (omn-to-time-signature seq (list (numerator resolution) (denominator resolution))) with insert-rounded = (append insert (rest (length-rational-quantize (list (apply '+ (omn :length insert))) :round resolution))) when (pattern-matchp (nth cnt new-seq) pitch) collect insert-rounded and do (incf cnt (/ (apply '+ (abs! (omn :length insert-rounded))) resolution)) collect (nth cnt new-seq)))))) ;;; -------------------------------------------------------------------------------------------- ;;; EXAMPLES ;;; -------------------------------------------------------------------------------------------- (setf seq '(3q cs5 c5 b4 q c4 d4 e. e4 s f4 h g4)) (setf omn-new (replace-pitch-by-sequence seq (list (rnd-pick (omn :pitch seq))) ;; for tests: takes rnd-pitches (rnd-pick '((t gs5 g5 fs5 f5 e5) ;; for tests: takes rnd-inserts (q gs5 -e e gs5) (3q gs5 tie q gs5) (s gs5 tie q gs5))))) (setf omn-old seq) ;;; -------------------------------------------------------------------------------------------- (def-score test (:title "test" :key-signature 'atonal :time-signature '(4 4) :tempo 90 :layout (bracket-group (treble-layout 'new) (treble-layout 'old))) (new :omn omn-new ;; OMN with iNSERT :channel 1 :port 1 :sound 'gm :program 'acoustic-grand-piano) (old :omn omn-old ;; OMN without iNSERT :channel 1 :port 1 :sound 'gm :program 'acoustic-grand-piano))
June 22, 20177 yr Author why is such an overwrite-function so usefull.... (also with no PM or ...)? Quote for example: you have coded some music but you would overwrite the last two quaternotes of bar 5 in the violin.... !?
Create an account or sign in to comment