Posted June 29, 20177 yr 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