overwriting

[AM]

 

i think, it works like that :-)

 

now, you could OVERWRITE you original OMN sequentially with inserts... (it's very useful for "post-production" of your generated score!). 

i have changed the input-format (bar/beat), and it also works with changing time-signatures... i know, janusz or the opmp-programmers could code it smarter, but my concept/code seems to work... so take it and optimize it!!!

 

greetings

andré

p.s. when wil be approx. the release of vers 2 of OPMO?

 

;;; OVERWRITING

(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 overwrite (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)
           
          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)))
                              
                              (+ (/ (* (1- ba) (/ (car time-sign) (cadr time-sign))) 
                                    (get-resolution2 be))
                                 (/ (/ (1- (car be)) (cadr be)) 
                                    (get-resolution2 be)))))
          
          do (setf seq 
                   (omn-to-time-signature 
                    (length-rest-merge 
                     (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 ins-rounded = (append ins 
                                                    (rest (length-rational-quantize
                                                           (list (apply '+ (omn :length ins)))
                                                           :round resolution)))
                         when (= cnt distance) collect ins-rounded 
                         and do (setf cnt (+ (/ (get-span (flatten ins-rounded)) resolution) 
                                             cnt -1))
                         else collect (nth cnt new-seq)))))
                    ord-time-sign))
          do (setf time-sign ord-time-sign)
          collect seq))))))



;;; EXAMPLES:

;;; with changing time-signatures

(overwrite '((e c6 a5 h b5 q tie) (q b5 b5 a5 tie) (q a5 q a5) (h. g5))
                        :insert '((3q c5 b4 bb4 a4) 
                                  (3q c4 b3 bb3 a3))

                        :bar/beat '((1 (2 12)) 
                                    (3 (1 12))))

;;; with constant time-signature
(overwrite '((e c6 a5 h b5 tie) (q b5 b5 a5 tie) (h a5 q a5) (h. g5))
                        :insert '((3q c5 b4 bb4 a4) 
                                  (3q c4 b3 bb3 a3))

                        :bar/beat '((1 (7 12)) 
                                    (3 (2 12))))

 

 

Edited June 29, 2017 by AM
replaced "get-resolution2"

[opmo]

Andre, why memberp and not member

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

 

[AM]

an "old user-function" from my library - just "habit", better with MEMBER. it's now replaced