Jump to content

AM

Members
  • Content Count

    544
  • Joined

  • Last visited

Everything posted by AM

  1. 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))))
  2. an "old user-function" from my library - just "habit", better with MEMBER. it's now replaced
  3. 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))))
  4. 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é
  5. ;;; ----------------------------------------------------------------------------- ;;; 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))
  6. hi, yes - with this two functions (get-posititon & inserting-on-bar/beat*) you will have a lot of possibilities... 1) post-processing an OMN without changing the global time structure 2) working with "strukturnetze" (lachenmann) 3) countrepoints 4) idea of palimpsts .... ...so, perhaps OPMO could code it smarter then me (that's not complicated :-))? ... i try to do an example today with something like a "strukturnetz"
  7. ;;; 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)
  8. 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))
  9. why is such an overwrite-function so usefull.... (also with no PM or ...)?
  10. 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))
  11. hi janusz was there a bug in my code? of course YOU coded it smarter :-) greetings andré
  12. ;;; -------------------------------------------------------------------------- ;;; "mirror image" of a cutout ;;; -------------------------------------------------------------------------- ;;; this function is generating a "mirror image" of a cutout ;;; by random-length/pos or by event-numbers ;;; the "untaken" part will be replaced by rests ;;; the "special thing is" to connect it exactly/immediately to the original-seq ;;; and as filtered-seq you could use it in an other part/instrument ;;; i coded it for my current work... so, take it or delete it! (defun mirror-seq (n omn-list &key (type 'r)) (let ((single-seq (single-events omn-list)) (seq) (rests)) (progn (setf seq (flatten (loop repeat (if (listp n) (cadr n) (1+ (random (- (length single-seq) n)))) for i in single-seq collect i))) (setf rests (neg! (apply '+ (mapcar 'abs (omn :length (flatten seq)))))) (setf seq (cond ((equal type 'r) (gen-retrograde seq)) ((equal type 'i) (pitch-invert seq)) ((equal type 'ri) (pitch-invert (gen-retrograde seq))))) (setf seq (flatten (loop repeat (if (listp n) (- (cadr n) (car n)) n) for i in (single-events seq) collect i))) (flatten (list rests seq))))) ;;; examples ;;; if n = integer -> random-seq ;;; if n = integer-list -> event-posititon => constant ;;; types r / i / ri (setf seq '(e. b3 mf c4 s d4 pp q eb4 e4 f4 t fs4)) ;;; retro (setf exp1 (mirror-seq 2 seq :type 'r)) (setf exp2 (mirror-seq '(1 4) seq :type 'r)) ;;; retro/inv ;(setf exp1 (mirror-seq 2 seq :type 'ri)) ;(setf exp2 (mirror-seq '(1 4) seq :type 'ri)) ;;; inv ;(setf exp1 (mirror-seq 2 seq :type 'i)) ;(setf exp2 (mirror-seq '(1 4) seq :type 'i)) (def-score only-anonsense-example (:title "exp" :key-signature 'atonal :time-signature '(4 4) :tempo 124 :layout (bracket-group (treble-layout 'original) (treble-layout 'exp1) (bass-layout 'exp2))) (original :omn seq :channel 1 :port 1 :sound 'gm :program 'acoustic-grand-piano) (exp1 :omn (pitch-transpose 0 exp1) :channel 1 :port 1 :sound 'gm :program 'acoustic-grand-piano) (exp2 :omn (pitch-transpose 0 exp2) :channel 1 :port 1 :sound 'gm :program 'acoustic-grand-piano)) added 3 minutes later in comination with length-augmentation (and tranpositions) you could generate a "distorted mirror image" in an other part/instrument
  13. use it if you like.. i needed it as a subfuction for length-legato* ... greetings andré (defun symmp (seq) (let ((seq2 (if (evenp (length seq)) (list (filter-first (/ (length seq) 2) seq) (reverse (filter-last (/ (length seq) 2) seq))) (list (filter-first (/ (1- (length seq)) 2) seq) (reverse (filter-last (/ (1- (length seq)) 2) seq)))))) (if (null (member 'nil (loop for i in (car seq2) for j in (cadr seq2) when (equal i j) collect 'T else collect 'NIL))) 't))) (symmp '(-1 2 3 5 5 3 2 -1)) (symmp '(-1 2 3 5 7 5 3 2 -1)) (symmp '(-1 2 3 4 5 3 2 -1)) (symmp '(c4 d4 fs5 d4 c4)) (symmp '(c4 d4 fs5 d4 b4)) (symmp '(mf f mp mp f mf)) (symmp '(mf f f mp fff f mf))
  14. violà, take it as a sketch... ;;; like this, but the question is how to structure the input-values ;;; the kind of structure decides about output... (defun filter-pattern (pattern omn-list) (progn (if (atom (car pattern)) (setf pattern (mapcar #'list pattern))) (flatten (loop for i in (single-events omn-list) with cnt = 0 when (pattern-matchp i (nth cnt pattern)) collect i and do (incf cnt) else collect (neg! (omn :length i)) when (= cnt (length pattern)) do (setf cnt 0))))) (setf seq '(e c4 mp -e fermata e. d4 -h e. c4 e e4)) (filter-pattern (rnd-sample-seq 2 (single-events seq)) '(e c4 mp -e fermata e. d4 -h e. c4 e e4)) (filter-pattern '((e. c4) (e4)) '(e c4 mp -e fermata e. d4 -h e. c4 e e4)) (filter-pattern '((c4) (e4)) '(e c4 mp -e fermata e. d4 -h e. c4 e e4)) (filter-pattern '(c4 e4) '(e c4 mp -e fermata e. d4 -h e. c4 e e4))
  15. an idea/extension could be to "filter-events" not only by singular pitches/lengths... but also by motifs, means sequences => "filter a PATTERN" function-name: filter-pattern
  16. AM

    Opusmodus 1.2.22292

    great work! hm, i would be nice, if i could add a optional fifhth/sixth/seventh-value to (l p v a)... in reality - for example - i want to split DIVISI-strings into parts, or splits 100 clarinets (because they are placed around the audience), or something else... this would be possible with opt.args... :-)
  17. here is a first version => replaces a PITCH by a sequence - overwriting the "old seq" - not very easy to CODE/understand how to do it :-) take a look an perhaps you have some more/better/extending ideas... a better way to solve the problems? greetings andré ;;; -------------------------------------------------------------------------------------------- ;;; FUNCTIONS ;;; -------------------------------------------------------------------------------------------- (defun get-resolution (seq pattern) (let ((val)) (progn (setq val (loop for i in (single-events seq) when (pattern-matchp i pattern) collect (denominator (car (omn :length i))))) (cond ((memberp (car val) '(3 6 12 24 48)) 1/24) ((memberp (car val) '(2 4 8 16 32)) 1/16) ((memberp (car val) '(5 10 20 40)) 1/20) ((memberp (car val) '(7 14 28 56)) 1/28))))) (defun replace-pitch-by-sequence (seq pitch insert) (let ((resolution (get-resolution seq pitch))) (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 (pattern-matchp (nth cnt new-seq) pitch) collect insert-rounded and do (incf cnt (/ (apply '+ (abs! (omn :length insert-rounded))) resolution)) collect (nth cnt new-seq)))))) ;;; -------------------------------------------------------------------------------------------- ;;; EXAMPLES ;;; -------------------------------------------------------------------------------------------- (setf seq '(3q cs5 c5 b4 q c4 d4 e. e4 s f4 h g4)) (setf omn-new (replace-pitch-by-sequence seq (list (rnd-pick (omn :pitch seq))) ;; for tests: takes rnd-pitches (rnd-pick '((t gs5 g5 fs5 f5 e5) ;; for tests: takes rnd-inserts (q gs5 -e e gs5) (3q gs5 tie q gs5) (s gs5 tie q gs5))))) (setf omn-old seq) ;;; -------------------------------------------------------------------------------------------- (def-score test (:title "test" :key-signature 'atonal :time-signature '(4 4) :tempo 90 :layout (bracket-group (treble-layout 'new) (treble-layout 'old))) (new :omn omn-new ;; OMN with iNSERT :channel 1 :port 1 :sound 'gm :program 'acoustic-grand-piano) (old :omn omn-old ;; OMN without iNSERT :channel 1 :port 1 :sound 'gm :program 'acoustic-grand-piano))
  18. yes, but wrong with this... '(s c4 tie s c4 tie s c4 tie s c4 s d4 tie s d4 tie s d4 tie s d4 s e4 tie s e4 tie s e4 1/24 gs5 1/24 1/24 s g4 tie s g4 tie s g4 tie s g4 tie s g4 tie s g4 tie s g4) because of the 1/24... why?
  19. thanx...!!! the concrete question was... i could eliminate the TIEs in such a sequence... (and add the tied 1/16-lengths) -> simplify the notation '(s c4 tie s c4 tie s c4 tie s c4 s d4 tie s d4 tie s d4 tie s d4 s e4 tie s e4 tie s e4 t gs5 g5 fs5 f5 e5 -1/32 s g4 tie s g4 tie s g4 tie s g4 tie s g4 tie s g4)
  20. hi all i'm trying to code a PM-function with an OVERWRITE, so that the global-lengths stays correct... i'm working this evening with some ideas for that and this is only a first sketch of a basic idea, don't know if it will work later... i have one little ordinary problem: to find/insert/overwrite i have to split the original sequence into small parts... that's the RESOLUTION, so i have a list with OMN-events in the span of the resolution. and a lot of TIEs -> at the end i would like to remove the tied-lengths by ordinary lengths? how? filter-tie works not with all insert-examples.... what can i do...? thanx andré ;;; -------------------------------------------------------------------------------------------- ;;; OVERWRITE -> überschreibt eine sequenz bei PM -> resolution einstellbar ;;; -------------------------------------------------------------------------------------------- ;;; ausgangs-sequenz (setf seq '(q c4 d4 e. e4 s f4 h g4)) ;;; inserts => test different INSERTS (setf insert '(t gs5 g5 fs5 f5 e5)) ;(setf insert '(q gs5 -e e gs5)) ;(setf insert '(1/24 gs5 1/24 1/24)) ;;; pattern => if such a pattern matched => now INSERT starting at PITCH f4 (setf pattern '(? f4)) ;;; resolution of SCANNING/INSERTING (setf resolution 1/16) ;;; -------------------------------------------------------------------------------------------- (setf omn-old seq) (setf omn-new (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 (pattern-matchp (nth cnt new-seq) pattern) collect insert-rounded and do (incf cnt (/ (apply '+ (abs! (omn :length insert-rounded))) resolution)) collect (nth cnt new-seq))) (setf omn-new (flatten omn-new)) ;;; -------------------------------------------------------------------------------------------- (def-score test (:title "test" :key-signature 'atonal :time-signature '(4 4) :tempo 90 :layout (bracket-group (treble-layout 'new) (treble-layout 'old))) (new :omn omn-new :channel 1 :port 1 :sound 'gm :program 'acoustic-grand-piano) (old :omn omn-old :channel 1 :port 1 :sound 'gm :program 'acoustic-grand-piano)) added 4 minutes later some other ideas to the main problems or some great solutions are very welcome :-)
  21. AM

    Fibonacci

    looks like adding intervals? ...code it! :-)
  22. data could also be midi-channel, prog-number....
  23. i see and unterstand what you mean... (as a non-programmer :-)), so i'm asking here some naive questions: a) isn't it better to "seperate" the BASIC-OMN-structure from the additionals? in a way, i'm more independet if OPMO changes some things? b) in my way i see completely transparent and easy what's up, and not a mixture of text-attributes/data...? c) if I could change the OPMO SINGLE-EVENTS-structure, i would extend it like I did ...and not mixing it, isnt' it much more "logic" (but perhaps not for a programmer-brain :-)) ...but... it is great to have such good inputs, that's what i'm looking for in this FORUM, thanx a lot torsten!!! herzlich andré added 8 minutes later in my view it would be nice to EXTEND the "make-omn/single-events"-structure by x-add-datas... like: (make-omn :length :pitch :velocity :articulation :data1 :data2 ... ... ...)
  24. if you want to control the global-pitch-progress, and not making/writing all length-list by hand you have to work/think (imo) with EVENTS (in opmo (single-events)), otherwise you will have all the time "random-stuff" or have incorrect synchronisations... but perhaps this is what you are looking for... all the best andré
×
×
  • Create New...