Jump to content

Recommended Posts

 

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 by AM
replaced "get-resolution2"
Link to comment
Share on other sites

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

 

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