Jump to content
Sign in to follow this  
AM

inserting on bar/beat

Recommended Posts

take it as a sketch... you can see the input/output

greetings andré

 

p.s. could be nice, if we combine it with a/the/my overwrite-function

p.s.s an overwrite-function could be very very smart for work... think: for example: you have coded some music but you would overwrite the last two quaternotes of bar  5 in the violin.... !?

 

 

;;; ------------------------------------------------------------------------
;;; INSERTING ON BAR/BEAT
;;; ------------------------------------------------------------------------



(defun inserting-on-bar/beat (insert &key time-sign bar beat)
  (let ((extra-rest (* -1 (/ (- (car beat) 1) (cadr beat))))
        (basic-time-sign time-sign)
        (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))))
                          
  (omn-to-time-signature
   (length-rest-merge
    (flatten 
     (append (if (> bar 1)
               (list (if (listp (car time-sign))
                       (loop repeat (- bar 1)
                         for i in time-sign
                         collect (* -1 (/ (car i) (cadr i))))
                       (* -1 (1- bar) (/ (car time-sign) (cadr time-sign))))))
             (length-rational-quantize 
              (if (/= 0 extra-rest)
                (append (list extra-rest) insert)
                insert)
              :round  (if (listp (car time-sign))
                        (/ (car (nth bar time-sign)) (cadr (nth bar time-sign)))
                        (/ (car time-sign) (cadr time-sign)))))))
   basic-time-sign)))





;;; ------------------------------------------------------------------------
;;; INSERTING ON BAR/BEAT
;;; ------------------------------------------------------------------------

(inserting-on-bar/beat '(s c4 d4 e4 f4 pp) 
                         :time-sign '(4 4)
                         :bar 2
                         :beat '(3 16))

(inserting-on-bar/beat '(5q c4 d4 e4 f4 pp) 
                         :time-sign '(4 4)
                         :bar 2
                         :beat '(2 20))

(inserting-on-bar/beat '(3q c4 d4 e4 f4 pp) 
                         :time-sign '(4 4)
                         :bar 1
                         :beat '(5 12))

  
(inserting-on-bar/beat '(s c4 d4 e4 f4 pp) 
                         :time-sign '((2 4 1) (3 8 1) (5 8 1) (3 4 1))
                         :bar 3
                         :beat '(3 16))

 

Share this post


Link to post
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.

Sign in to follow this  

  • Similar Topics

    • By AM
      hi all
       
      the following function could be usefull, it's a first sketch, but it seems to work....
       
      if you want to INSERT a new OMN-seq, perhaps in bar 2 on the 3/20 in your BASIC-OMN-sequence... with this function you can do this, it will overwrite your original phrase.
      test it or tell me whatelse would be better...
       
      greetings
      andré
       
      ;;; ------------------------------------------------------------------------ ;;; INSERTING SEQ BY OVERWRITING ;;; ------------------------------------------------------------------------ ;;; SUB (defun get-resolution2 (beat) (cond ((memberp (cadr beat) '(3 6 12 24 48)) 1/24) ((memberp (cadr beat) '(1 2 4 8 16 32)) 1/16) ((memberp (cadr beat) '(5 10 20 40)) 1/20) ((memberp (cadr beat) '(7 14 28 56)) 1/28))) ;;; MAIN: INSERTING SEQ BY OVERWRITING (defun inserting-on-bar/beat* (seq &key insert time-sign bar beat) (let ((resolution (get-resolution2 beat)) (ord-time-sign time-sign) (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)) (+ (car (loop repeat (- bar 1) for i in time-sign collect (/ (* (1- bar) (/ (car i) (cadr i))) (get-resolution2 beat)))) (/ (/ (1- (car beat)) (cadr beat)) (get-resolution2 beat))) (+ (/ (* (1- bar) (/ (car time-sign) (cadr time-sign))) (get-resolution2 beat)) (/ (/ (1- (car beat)) (cadr beat)) (get-resolution2 beat)))))) (omn-to-time-signature (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 insert-rounded = (append insert (rest (length-rational-quantize (list (apply '+ (omn :length insert))) :round resolution))) when (= cnt distance) collect insert-rounded and do (setf cnt (+ (/ (get-span (flatten insert-rounded)) resolution) cnt -1)) else collect (nth cnt new-seq)))) ord-time-sign))) ;;; EXAMPLES (inserting-on-bar/beat* '((e c6 a5 h b5 tie) (q b5 b5 a5 tie) (h a5 q a5) (h. g5)) :insert '(s f3 e3 eb3 d3) :time-sign '(3 4) :bar 2 :beat '(2 16)) (inserting-on-bar/beat* '((e c6 a5 h b5 tie) (q b5 b5 a5 tie) (h a5 q a5) (h. g5)) :insert '(3q c5 b4 bb4 a4) :time-sign '(3 4) :bar 1 :beat '(2 12)) ;;; EXAMPLE WITH different TIME-SIGNATURES (inserting-on-bar/beat* '(e c6 a5 h b5 tie q b5 b5 a5 tie h a5 q a5 h. g5) :insert '(5q c5 b4 bb4 a4) :time-sign '((2 4 1) (3 8 1) (5 8 1) (3 4 1)) :bar 3 :beat '(3 20))  
    • By AM
      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))))  
    • By AM
      ;;; gets the position => bar and beat where the value is ;;; => could be used in combination with "inserting-on-bar/beat*", ;;; if you are looking for a specific value to sprout a sequqnce ;;; FUNCTION (defun get-position (seq value &key (get 'all)) (let ((beat) (bar (car (loop for i in seq for bar = 1 then (incf bar) append (loop for j in (single-events i) when (pattern-matchp j (list value)) collect bar))))) (progn (setf beat (loop for k in (loop for i in (single-events (nth (1- bar) seq)) when (not (pattern-matchp i (list value))) append (omn :length i) else collect 'match) when (numberp k) collect (abs k) into bag when (equal k 'match) do (return (list (1+ (numerator (abs (sum bag)))) (denominator (abs (sum bag)))))))) (cond ((equal get 'all) (list bar beat)) ((equal get 'bar) (append bar)) ((equal get 'beat) (append beat))))) ;;; EXAMPLES: (setf seq '((h c4 q q) (e f4 pp f4 mp f4) (-3q 3q cs5 -3q h))) (get-position seq 'cs5 :get 'all) (get-position seq 'cs5 :get 'bar) (get-position seq 'cs5 :get 'beat) (get-position seq 'pp :get 'all)  
×
×
  • Create New...