Jump to content

replace-pitch-by-sequence (with overwrite) - version1


Recommended Posts

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))

 

Link to comment
Share on other sites

  • 4 weeks later...

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.... !?

 

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...

Important Information

Terms of Use Privacy Policy