Jump to content
AM

inserting a sequence by overwriting

Recommended Posts

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

 

Edited by AM
bug fixed

Share this post


Link to post
Share on other sites
;;; -----------------------------------------------------------------------------
;;; EXAMPLE -> an abstract example how it works (get-position/inserting-on-bar/beat*)
;;; -----------------------------------------------------------------------------


;;; SUB

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

(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 WITH OVERWRITE

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



;;; -----------------------------------------------------------------------------
;;; THE EXAMPLE 
;;; -----------------------------------------------------------------------------


(init-seed (random 20))

;;; GENERATING A "NONSENSE STRUCTURAL NET"

(setf basic-mat (omn-to-time-signature
                 (make-omn :pitch (integer-to-pitch (rnd-row))
                          :length (flatten (gen-mix (gen-length (gen-repeat 12 1) 1/16) 
                                                    (gen-length (mapcar '1+ (rnd-row)) -1/16)))
                          :velocity '(ppp))
                 '(4 4)))

;;; -----------------------------------------------------------------------------

;;; THE "GET-POSITION" searchs the position (bar/beat) of a specific value)
;;; and "inserting-on-bar/beat*" overwrites the basic OMN, and the iNSERT
;;; is sproutet at the  VALUE-point => here is an example with axiom and 4 generations

;;; FIRST GENERATION -> VALUE 'b4
(setf mat0 (inserting-on-bar/beat* basic-mat
                                   :insert '(s b4 ff cs5 ds5 e5 e fs5 fs5)  
                                   :time-sign '(4 4) 
                                   :bar (get-position basic-mat 'b4 :get 'bar)
                                   :beat (get-position basic-mat 'b4 :get 'beat)))

;;; SECOND GENERATION -> VALUE 'gs4
(setf mat1 (inserting-on-bar/beat* mat0
                                   :insert (pitch-transpose -3 (pitch-invert '(s b4 ff cs5 ds5 e5 e fs5 fs5) ) )
                                   :time-sign '(4 4) 
                                   :bar (get-position mat0 'gs4 :get 'bar)
                                   :beat (get-position mat0 'gs4 :get 'beat)))


;;; THIRD GENERATION -> VALUE 'g4
(setf mat2 (inserting-on-bar/beat* mat1
                                   :insert '(q g4 ff e4 h e4 q f4 d4 h d4)  
                                   :time-sign '(4 4) 
                                   :bar (get-position mat1 'g4 :get 'bar)
                                   :beat (get-position mat1 'g4 :get 'beat)))

;;; FOURTH GENERATION -> VALUE 'ds5 (is an elemnt of the INSERT in first generation!)
(setf mat3 (inserting-on-bar/beat* mat2
                                   :insert (pitch-transpose 4 (pitch-invert '(s b4 ff cs5 ds5 e5 e fs5 fs5) ) )
                                   :time-sign '(4 4) 
                                   :bar (get-position mat2 'ds5 :get 'bar)
                                   :beat (get-position mat2 'ds5 :get 'beat)))



(def-score solo-trumpet
           (:title "solo trumpet"
                   :key-signature 'atonal  
                   :time-signature '(4 4)
                   :tempo 134
                   :layout (bracket-group 
                            (treble-layout 'original)
                            (treble-layout 'overwrite1) ; gen1
                            (treble-layout 'overwrite2) ; gen2
                            (treble-layout 'overwrite3) ; gen 3
                            (treble-layout 'overwrite4))) ; gen 4
  

  (original 
   :omn basic-mat
   :channel 1
   :sound 'gm
   :program 'acoustic-grand-piano)

  (overwrite1 
   :omn mat0
   :channel 1
   :sound 'gm
   :program 'acoustic-grand-piano)

  (overwrite2 
   :omn mat1
   :channel 1
   :sound 'gm
   :program 'acoustic-grand-piano)
    (overwrite3 
   :omn mat2
   :channel 1
   :sound 'gm
   :program 'acoustic-grand-piano)
  (overwrite4 
   :omn mat3
   :channel 1
   :sound 'gm
   :program 'acoustic-grand-piano))

 

added 12 minutes later

another, easy-to-understand example

 

;;; -----------------------------------------------------------------------------
;;; EXAMPLE2 
;;; -----------------------------------------------------------------------------


(init-seed (random 20))

;;; GENERATING A "NONSENSE STRUCTURAL NET"

(setf basic-mat (omn-to-time-signature
                 (make-omn :pitch (integer-to-pitch (rnd-row))
                           :length (flatten (gen-mix (gen-length (gen-repeat 12 1) 1/16) 
                                                    (gen-length (mapcar '1+ (rnd-row)) -1/16)))
                           :velocity '(ppp))
                 '(4 4)))

;;; -----------------------------------------------------------------------------


;;; PICKING A PITCH RANDOMLY
(setf value (rnd-pick (flatten (omn :pitch basic-mat))))


;;; INSERTS AT THE POSITION OF THE RANDOMLY CHOSEN PITCH
(setf mat0 (inserting-on-bar/beat* basic-mat
                                   :insert (make-omn :pitch (pitch-transpose-start value 
                                                                                   '(b4 cs5 ds5 e5 e fs5 fs5 gs5 gs5 gs5 gs5 fs5)) 
                                                     :length '(s s s s  e e s s s s  q)
                                                     :velocity '(fff))
                                   :time-sign '(4 4) 
                                   :bar (get-position basic-mat value :get 'bar)
                                   :beat (get-position basic-mat value :get 'beat)))


(def-score solo-trumpet
           (:title "solo trumpet"
                   :key-signature 'atonal  
                   :time-signature '(4 4)
                   :tempo 134
                   :layout (bracket-group 
                            (treble-layout 'original)
                            (treble-layout 'overwrite1)))  

  (original 
   :omn basic-mat
   :channel 1
   :sound 'gm
   :program 'acoustic-grand-piano)

  (overwrite1 
   :omn mat0
   :channel 1
   :sound 'gm
   :program 'acoustic-grand-piano))

 

Share this post


Link to post
Share on other sites

EXAMPLE 3 -> inserts "by hand"

 

;;; -----------------------------------------------------------------------------
;;; EXAMPLE 3 PLACING BY HAND AT BAR/BEAT
;;; -----------------------------------------------------------------------------

(init-seed 5)
;(init-seed (random 5))


;;; GENERATING A "NONSENSE STRUCTURAL NET"

(setf basic-mat (omn-to-time-signature
                 (make-omn :pitch (integer-to-pitch (rnd-row))
                           :length (flatten (gen-mix (gen-length (gen-repeat 12 1) 1/16) 
                                                    (gen-length (mapcar '1+ (rnd-row)) -1/8)))
                           :velocity '(ppp))
                 '(4 4)))

;;; -----------------------------------------------------------------------------

;;; YOU WANT TO PUT AN INSERT at BAR 3 on the 2/16 beat
(setf mat0 (inserting-on-bar/beat* (length-rest-merge basic-mat)
                                   :insert (rnd-sample-seq 5 (make-omn :pitch (integer-to-pitch (rnd-row))
                                                                       :length (rnd-repeat 12 '(1/32))
                                                                       :velocity '(fff)))
                                   :time-sign '(4 4)
                                   :bar 3
                                   :beat '(2 16)))

;;; -----------------------------------------------------------------------------


;;; YOU WANT TO PUT AN INSERT at BAR 2 on the 3/20 beat
(setf mat0 (inserting-on-bar/beat* (length-rest-merge mat0)
                                   :insert (rnd-sample-seq 5 (make-omn :pitch (integer-to-pitch (rnd-row))
                                                                       :length (rnd-repeat 12 '(1/20))
                                                                       :velocity '(fff)))
                                   :time-sign '(4 4)
                                   :bar 2
                                   :beat '(3 20)))

;;; -----------------------------------------------------------------------------


;;; YOU WANT TO PUT AN INSERT at BAR 6 on the 5/24 beat
(setf mat0 (inserting-on-bar/beat* (length-rest-merge mat0)
                                   :insert (rnd-sample-seq 5 (make-omn :pitch (integer-to-pitch (rnd-row))
                                                                       :length (rnd-repeat 12 '(1/24))
                                                                       :velocity '(fff)))
                                   :time-sign '(4 4)
                                   :bar 6
                                   :beat '(5 24)))

(setf mat0 (length-rest-merge mat0))

;;; -----------------------------------------------------------------------------
;;; SCORE
;;; -----------------------------------------------------------------------------


(def-score solo-trumpet
           (:title "solo trumpet"
                   :key-signature 'atonal  
                   :time-signature '(4 4)
                   :tempo 134
                   :layout (bracket-group 
                            (treble-layout 'original)
                            (treble-layout 'overwrite1)))  

  (original 
   :omn basic-mat; ORIGINAL
   :channel 1
   :sound 'gm
   :program 'acoustic-grand-piano)

  (overwrite1; ORIGINAL WITH INSERTS/OVERWRITES 
   :omn mat0
   :channel 1
   :sound 'gm
   :program 'acoustic-grand-piano))

 

added 1 minute later

it's not perfect, some bugs from time to time (if you do something "special")... try to fix it...

greetings

andré

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×