Jump to content

Recommended Posts

here is a function that can be used for "post-..." of an OMN score...

you could INSERT a sequence by BAR/BEAT (a slightly modified variant of OVERWRITE), so you can 

place your insert exactly!

 

greetings

andré

 

;;; INSERTING

(defun get-resolution2 (be)
  (cond ((member (cadr be) '(3 6 12 24 48))
         1/24)
        ((member (cadr be) '(1 2 4 8 16 32))
         1/16)
        ((member (cadr be) '(5 10 20 40))
         1/20)
        ((member (cadr be) '(7 14 28 56 1))
         1/28)))

(defun insert (seq &key insert bar/beat)
   (car 
    (last
     (let ((bar) (beat) (resolution) (distance))
       (progn
         (setf bar (loop for i in bar/beat collect (car i))
               beat (loop for j in bar/beat collect (cadr j)))
         (loop 
           for ba in bar 
           for be in beat
           for ins in insert
           with time-sign = (get-time-signature seq)
           with ord-time-sign = (get-time-signature seq)
           ;with ins-rounded = '(0)
           with ins-add = '(0)
           
          do (setf resolution (get-resolution2 be)
                   time-sign (if (listp (car time-sign))
                               (loop for i in time-sign
                                 when (> (caddr i) 1)
                                 append (loop repeat (caddr i)
                                          collect (list (car i) (cadr i)))
                                 else collect (list (car i) (cadr i)))
                               (append time-sign))
                   
                   distance (if (listp (car time-sign))
                              (+ (sum (loop repeat (- ba 1)
                                        for i in time-sign
                                        collect (/ (/ (car i) (cadr i))
                                                   (get-resolution2 be))))
                                 (/ (/ (1- (car be)) (cadr be)) 
                                    (get-resolution2 be))
                                 ;;; ins-rounded add
                                 (/ (get-span (flatten ins-add))
                                    (get-resolution2 be))
                                 )
                              
                              (+ (/ (* (1- ba) (/ (car time-sign) (cadr time-sign))) 
                                       (get-resolution2 be))
                                 (/ (/ (1- (car be)) (cadr be)) 
                                       (get-resolution2 be))
                                 ;;; ins-rounded add
                                 (/ (get-span (flatten ins-add))
                                    (get-resolution2 be)))
                                 ))
           
          do (setf seq 
                   (omn-to-time-signature 
                    (length-rest-merge 
                      (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 ins-rounded = (append ins 
                                                    (rest (length-rational-quantize
                                                           (list (apply '+ (mapcar 'abs (omn :length ins))))
                                                           :round resolution)))
                         when (= cnt distance) collect ins-rounded and do (setf ins-add (append ins-rounded ins-add))
                         else collect (nth cnt new-seq))))
                    ord-time-sign))
          do (setf time-sign ord-time-sign)
          collect (omn-merge-ties seq)))))))



;;; EXAMPLES:

;;; with changing time-signatures

(insert '((e c6 a5 h b5 q tie) (q b5 b5 a5 tie) (q a5 q a5) (h. g5))
                        :insert '((-3q 3q c5 b4 bb4 a4) 
                                  (-3q 3q c4 b3 bb3 a3))
						;;; bar numbers has to be in ascending order!
                        :bar/beat '((1 (1 12)) 
                                    (3 (1 12))))


(insert '((e c6 a5 h b5 q tie) (q b5 b5 a5 tie) (q a5 q a5) (h. g5))
                        :insert '((-2/12))
                        :bar/beat '((2 (2 12)))) 


;;; with constant time-signature

(insert '((e c6 a5 h b5 tie) (q b5 b5 a5 tie) (h a5 q a5) (h. g5))
                        :insert '((3q c5 b4 bb4 a4) 
                                  (-3q 3q c4 b3 bb3 a3))
						;;; bar numbers has to be in ascending order!
                        :bar/beat '((1 (7 12)) 
                                    (3 (2 12))))


(insert '((e c6 a5 h b5 tie) (q b5 b5 a5 tie) (h a5 q a5) (h. g5))
                        :insert '((-h.))
                        :bar/beat '((2 (1 4)))) 
                                    

 

Edited by AM
bug fixed (thinking error)
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