Jump to content

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
Link to comment
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))

 

Link to comment
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é

Link to comment
Share on other sites

  • 1 year later...
  • 1 month later...

OVERWRITE FUNCTION: first time i'm working with this function (i coded it a year ago)... to overwrite the output/score => INSERTS....

- and it's very useful, perhaps JANUSZ could code an official OPMO-version of this which works perfect?

 

greetings

andré

;;; OVERWRITE!! ----------------------------------------------

(defun memberp (n liste)
  (not (equal 'nil (member n liste))))

(defun get-resolution2 (be)
  (cond ((memberp (cadr be) '(3 6 12 24 48))
         1/24)
        ((memberp (cadr be) '(1 2 4 8 16 32))
         1/16)
        ((memberp (cadr be) '(5 10 20 40))
         1/20)
        ((memberp (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))))))

 

 

 

TWO EXAMPLES:

 


;;; in a 3/4

(setf seq1 '((e c6 a5 h b5 tie) (q b5 b5 a5 tie) (h a5 q a5) (h. g5)))
(overwrite seq1
           :insert '((3q c5 b4 bb4 a4) 
                     (3q c4 b3 bb3 a3))
           
           :bar/beat '((2 (2 12)) 
                       (3 (7 12))))


;;; with changing time-signatures

(setf seq2 '((e c6 a5 h b5 q tie) (q b5 b5 a5 tie) (q a5 q a5) (h. g5)))
(overwrite seq2
           :insert '((3q c5 b4 bb4 a4) 
                     (3q c4 b3 bb3 a3))
           
           :bar/beat '((1 (2 12)) 
                       (3 (1 12))))

 

 

 

 

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