AM Posted June 22, 2017 Share Posted June 22, 2017 (edited) 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 June 23, 2017 by AM bug fixed Yuichi Yamamoto and Stephane Boussuge 2 Quote Link to comment Share on other sites More sharing options...
AM Posted June 23, 2017 Author Share Posted June 23, 2017 ;;; ----------------------------------------------------------------------------- ;;; 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)) Quote Link to comment Share on other sites More sharing options...
AM Posted June 23, 2017 Author Share Posted June 23, 2017 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é Stephane Boussuge 1 Quote Link to comment Share on other sites More sharing options...
Stephane Boussuge Posted August 26, 2018 Share Posted August 26, 2018 Very interesting André. I would like very much if Janusz improve and add this and your get-position function into the system Janusz ? Thank you André for that. S. JulioHerrlein 1 Quote Link to comment Share on other sites More sharing options...
Stephane Boussuge Posted August 27, 2018 Share Posted August 27, 2018 Maybe you have to use let* in place of let, no ? SB. Quote Link to comment Share on other sites More sharing options...
AM Posted October 24, 2018 Author Share Posted October 24, 2018 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)))) Stephane Boussuge 1 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.