Jump to content

Featured Replies

Posted

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

 

Create an account or sign in to comment


Copyright © 2014-2025 Opusmodus™ Ltd. All rights reserved.
Product features, specifications, system requirements and availability are subject to change without notice.
Opusmodus, the Opusmodus logo, and other Opusmodus trademarks are either registered trademarks or trademarks of Opusmodus Ltd.
All other trademarks contained herein are the property of their respective owners.

Powered by Invision Community

Important Information

Terms of Use Privacy Policy