AM Posted May 29, 2017 Share Posted May 29, 2017 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)) Stephane Boussuge 1 Quote Link to comment Share on other sites More sharing options...
AM Posted June 22, 2017 Author Share Posted June 22, 2017 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.... !? Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.