Jump to content

AM

Members
  • Posts

    816
  • Joined

  • Last visited

Everything posted by AM

  1. bad code-style, but modify/use it... ;;; FUNCTION ;;; expands (merges) length-values in the order of the substructure-list ;;; by inverting immediate following length-rests. ;;; (defun gen-legato-substructure (omn-list substructure-list) (loop repeat (length (single-events omn-list)) with event-list = (single-events omn-list) with sub-cnt = 0 for cnt = 0 then (incf cnt) when (and (equal (car (cond ((lengthp (car substructure-list)) (omn :length (nth cnt event-list))) ((pitchp (car substructure-list)) (omn :pitch (nth cnt event-list))) ((velocityp (car substructure-list)) (omn :velocity (nth cnt event-list))) ((articulationp (car substructure-list)) (omn :articulation (nth cnt event-list))))) (nth sub-cnt substructure-list)) (length-restp (car (nth (1+ cnt) event-list)))) collect (omn-replace :length (+ (car (omn :length (nth cnt event-list))) (abs (car (omn :length (nth (1+ cnt) event-list))))) (nth cnt event-list)) and do (incf cnt) and do (incf sub-cnt) else collect (nth cnt event-list) when (= sub-cnt (length substructure-list)) do (setf sub-cnt 0))) ;;; generating something like noise (setf mat (flatten (make-omn :pitch (loop repeat 100 collect (rnd-pick '(c4 d4 e4 f4 g4 a4 b4 c5))) :length (loop repeat 100 collect '(1/16 -13/16)) :velocity (loop repeat 100 collect (rnd-pick '(p mp mf f))) :articulation (loop repeat 100 collect (rnd-pick '(ord flaut ponte)))))) ;;; EXAMPLES: ;;; makes a "LEGATO" on this seq '(c4 d4 b4 f4) (setf omn (gen-legato-substructure mat '(c4 d4 b4 f4))) ;;; makes a "LEGATO" on this seq '(ponte ord flaut) ;(setf omn (gen-legato-substructure mat '(ponte ord flaut))) (def-score example (:title "example" :key-signature 'atonal :time-signature '(4 4) :tempo 90) (instr :omn omn :channel 1 :sound 'gm :program 'acoustic-grand-piano))
  2. perhaps you could also add :space-notation to your todo list? greetings andré
  3. bad coding-style, but a useful function -> implement in OM? all the best andré (defun filter-pitches-octave-independent (pitches filter-pitch &key (bandwith 10)) (let ((search-field (loop for j in filter-pitch append (append (reverse (loop repeat (/ bandwith 2) with p1 = (pitch-to-midi j) collect (setq p1 (- p1 12)))) (list (pitch-to-midi j)) (loop repeat (/ bandwith 2) with p2 = (pitch-to-midi j) collect (setq p2 (+ p2 12))))))) (loop for i in (pitch-to-midi pitches) when (not (null (member i search-field))) collect (midi-to-pitch i)))) (filter-pitches-octave-independent '(c4 d4 e6) '(d3 c1)) => (c4 d4)
  4. thanx a lot for that "professional approach"! herzlichen dank für diese lösung, viel smarter :-)
  5. here is a solution - because i didn't know how it works in pure OM/OMN greetings andré ;;; SUB (defun gen-events-from-lists (&key durations pitches (velocities 'nil) (articulations 'nil) (optional_data1 'nil) (optional_data2 'nil) (optional_data3 'nil)) (loop repeat (length durations) with cnt1 = 0 with cnt2 = 0 with event-cnt = 0 when (> (nth cnt1 durations) 0) collect (list (nth cnt1 durations) (nth cnt2 pitches) (nth cnt2 velocities) (nth cnt2 articulations) (nth cnt2 optional_data1) (nth cnt2 optional_data2) (nth cnt2 optional_data3) event-cnt) and do (incf cnt1) and do (incf cnt2) else collect (list (nth cnt1 durations) nil nil nil nil nil nil event-cnt) and do (incf cnt1) do (incf event-cnt))) (defun gen-omn-from-events (event-stream) (length-rest-merge (loop for i in event-stream append (loop for j in (butlast i) when (not (equal j 'nil)) collect j)))) ;;; MAIN (defun replace-velocity-of-a-technique (omn-list technique velocity) (gen-omn-from-events (loop for i in (gen-events-from-lists :durations (flatten (omn :length omn-list)) :pitches (flatten (omn :pitch omn-list)) :velocities (flatten (omn :velocity omn-list)) :articulations (flatten (omn :articulation omn-list))) collect (pattern-map (list (list (list '? technique) (list velocity technique))) i)))) ;;; EXAMPLE (replace-velocity-of-a-technique '(e. c4 pppp tasto d4 ponte e4) 'tasto 'fff) => (e. c4 fff tasto d4 pppp ponte e4 -)
  6. thanx, but the rest of the sequence should be/stay "pppp"
  7. i tried, but it didn't work... why, where is my mistake? (pattern-map '((pppp tasto) (ff tasto)) '(e. c4 pppp tasto d4 ponte e4) :type :velocity)
  8. first question i would like to replace the dynamics of all "tasto"-sounds in an OMN-sequence, is there a function for that? for example '(e. c4 pppp tasto d4 ponte e4) -> replace only the dynamic of the TASTO result should be: '(e. c4 f tasto d4 ppp ponte e4) second question (if i want to code it for myself) ...is there always a constant dataset/stream (events) in the "background"? like : '((e. c4 pppp tasto) (e. d4 pppp ponte) (e. e4 pppp ponte))? which function shows me this, so called, EVENTS. for some coding this format is a lot more usefull then seperat lists of each parameter thanks for help and HAPPY CHRISTMAS andré
  9. if you want to modify "a weight" from GEN-generation to next GEN-generation you could use this... (modifying a weight could be useful if you want to give your production-rules a global drift) greetings andré (defun modify-weight (&key weight (step 0.1) type (threshold 0.5) (span '(0 1)) (max-weight 1.0)) (cond ((or (equal type 'incr) (equal type 'decr)) (progn (setq weight (cond ((equal type 'incr) (incf weight step)) ((equal type 'decr) (decf weight step)))) (if (and (> weight 0) (< weight max-weight)) (append weight) (cond ((>= weight max-weight) (random (- 1 threshold))) ((<= weight 0) (+ (random (- 1 threshold)) threshold)))))) ((equal type 'incr-noreset) (if (< weight max-weight) (incf weight step) (append max-weight))) ((equal type 'decr-noreset) (if (> weight 0) (decf weight step) (append 0))) ((equal type 'rnd) (+ (random (- 1 threshold)) threshold)) ((equal type 'rnd-span) (rnd-round (first span) (second span))))) ;;; EXAMPLES TO TEST THE FUNCTION -> ev. every example a few times to check it (setf weight 0.1) ;;; counts up until default-max-weight (1.0), then rnd-reset (setf weight (modify-weight :type 'incr :weight weight :step 0.2)) (setf weight 0.1) ;;; counts up, stays at max-weight (setf weight (modify-weight :type 'incr-noreset :weight weight :step 0.2 :max-weight 3.0)) (setf weight 1.0) ;;; counts down until 0, then rnd-reset (setf weight (modify-weight :type 'decr :weight weight :step 0.1)) (setf weight 1.0) ;;; counts up, stays at 0 (setf weight (modify-weight :type 'decr-noreset :weight weight :step 0.1)) (setf weight 1.0) ;;; rnd-weights, larger then threshold (setf weight (modify-weight :type 'rnd :threshold 0.3)) (setf weight 1.0) ;;; rnd-weights, in SPAN (setf weight (modify-weight :type 'rnd-span :span '(0.3 0.6)))
  10. i needed something like that (to fit sequences in a FRAME), don't know if it exists... very simple... (defun length-rest-sum (omn-list) (loop for i in (omn :length omn-list) sum (abs i)))
  11. hi wim so it is up to us to share ideas and code here in the forum :-) greetings andré
  12. Finally it is the question whether you want to generate music with the help of blackboxes/tools (whether open source or OM)... or you want to think, to reflect and to program your own ideas, and not to take what tools can easily generate (in this case you are not/less "independent"). with LISP (coding almost everything for myself) and OM for MIDI and SCORE it works for me... i think it's not a question of open source or not...
  13. simple question (from a-non-programmer) - for what can you use that tooll? greetings andré
  14. code from another project, but should work in a similar way. take it, modify it, or code it properly :-) regards andré ;; gen-hoquetus.4 https://en.wikipedia.org/wiki/Hocket ;;; andré meier / 27-4-2016 ;;; write a instrumentation-list (instrument + techniques + velocity), pitch-list ;;; and length-list. the gen-hoquetus-function will split the melody ;;; off... in any possibilities, techniques/articulations/velocities will be added ;;; this is only a function i coded for my actual work... perhaps you could use ;;; it or code it properly :-) ;;; HAVE FUN! regards, andré (setq instrumentation '(((pno ponte ppp)) ((vn pizz p)) ((vn pizz f) (va ponte f)) ((pno tasto ff)) ((pno pizz fff)) ((vn tasto mf) (pno ord ff) (vc tasto mf) (trp ord pp)) ((trp mute pp) (vn ponte mf)))) ;; subfunctions (defun generate-events.4 (durations pitches &key (velocity '(mf)) (articulation '(-)) (optional_data 'nil)) (loop repeat (length durations) with cnt-d = 0 with cnt-rest = 0 when (> (nth cnt-d durations) 0) collect (list (nth cnt-d durations) (nth cnt-rest pitches) (nth cnt-rest velocity) (nth cnt-rest articulation) (nth cnt-rest optional_data)) and do (incf cnt-rest) and do (incf cnt-d) else collect (list (nth cnt-d durations) 'nil 'nil 'nil 'nil) and do (incf cnt-d))) (generate-events.4 '(1 2 -3 4) '(60 61 62) :optional_data instrumentation) ;; (defun filtering-color.4 (selected-color event-stream) (loop for i in event-stream with match = 0 append (loop for x in (fifth i) when (equal (first x) selected-color) do (setq articulation (second x) velocity (third x)) and do (setq match 1)) when (and (= match 1) (> (first i) 0)) append (list (first i) (second i) velocity articulation) else collect (* -1 (abs (first i))) do (setq match 0))) (filtering-color.4 'vn (generate-events.4 (gen-length '(1 -100 2 3 4 5) 1/32) '(c4 d4 e4 e5) :optional_data instrumentation)) ;; mainfuction: (defun gen-hoquetus.4 (filtered-instrument &key pitch length instrument-list) (let ((events (generate-events.4 length pitch :optional_data instrument-list))) (filtering-color.4 filtered-instrument events))) (gen-hoquetus.4 'vn :pitch '(c4 d4 e5 f6) :length '(1/32 2/32 3/32 4/32) :instrument-list instrumentation) ;; OMN_EXAMPLE: (setq pitches (midi-to-pitch '(60 61 62 63 64 65 66 67 68 69 70))) ; only an example (setq lengths (gen-length '(1 2 3 -4 5 6 5 -4 3 -2 1) 1/16)) ; only an example (setq instrumentation (loop repeat 10 collect (rnd-pick '(((pno ponte ppp)) ; only an example ((vn pizz p)) ((vn pizz f) (va ponte f)) ((pno tasto ff)) ((pno pizz fff)) ((vn tasto mf) (pno ord ff) (vc tasto mf) (trp ord pp)) ((trp mute pp) (vn ponte mf)))))) (def-score hoquetus.4 (:key-signature '(c maj) :time-signature '(4 4) :tempo '(120) :layout (bracket-group (trumpet-layout 'trumpet) (piano-grand-layout 'piano) (violin-layout 'violin) (viola-layout 'viola) (violoncello-layout 'violoncello))) (trumpet :omn (gen-hoquetus.4 'trp :pitch pitches :length lengths :instrument-list instrumentation) :channel 1) (piano :omn (gen-hoquetus.4 'pno :pitch pitches :length lengths :instrument-list instrumentation) :channel 1) (violin :omn (gen-hoquetus.4 'vn :pitch pitches :length lengths :instrument-list instrumentation) :channel 1) (viola :omn (gen-hoquetus.4 'va :pitch pitches :length lengths :instrument-list instrumentation) :channel 1) (violoncello :omn (gen-hoquetus.4 'vc :pitch pitches :length lengths :instrument-list instrumentation) :channel 1))
  15. should work... (defun get-root-intervals (pitches) (integer-to-interval (sort-asc (pitch-to-integer (ambitus-octaves 'c4 1 pitches))))) (get-root-intervals '(g1 c9 e6)) (get-root-intervals '(f3 d4 a4)) interested to see your work :-) greetings andré
  16. here is a version with MULTIPLE replacements... you have to write replacements different... a list in a list... have a look to the examples: (defun omn-component-replace2 (omn-sequence replace-component) (car (last (loop for i in replace-component collect (setf omn-sequence (make-omn :length (if (lengthp (car i)) (append i) (omn :length omn-sequence)) :pitch (if (pitchp (car i)) (append i) (omn :pitch omn-sequence)) :velocity (if (velocityp (car i)) (append i) (omn :velocity omn-sequence)) :articulation (if (articulationp (car i)) (append i) (omn :articulation omn-sequence)))))))) (omn-component-replace2 '(S C4 PPP TASTO Q.T D4 PPPP TASTO S E4 PPP TASTO) '((p))) (omn-component-replace2 '(S C4 PPP TASTO Q.T D4 PPPP TASTO S E4 PPP TASTO) '((p) (ponte) (e2 b2 d2)))
  17. hi stephane i think it works fine, feel free to use & optimize it ( perhaps to replace more then ONE parameter in ONE function-call?)... for me the function is very useful... greetings andré (defun omn-component-replace (omn-sequence replace-component) (make-omn :length (if (lengthp (car replace-component)) (append replace-component) (omn :length omn-sequence)) :pitch (if (pitchp (car replace-component)) (append replace-component) (omn :pitch omn-sequence)) :velocity (if (velocityp (car replace-component)) (append replace-component) (omn :velocity omn-sequence)) :articulation (if (articulationp (car replace-component)) (append replace-component) (omn :articulation omn-sequence)))) examples: (setf seq1 '(s gs3 ppp tasto q.t cs4 pppp tasto s f4 ppp tasto)) (omn-component-replace seq1 '(5/16 7/16 3/32)) (omn-component-replace seq1 '(ponte)) (omn-component-replace seq1 '(c4 d4 e4 f4))
  18. version in (almost) pure lisp (only "midi-to-pitch" is OM) (defun gen-sieve-userdefined (ambitus.midi intervals) (midi-to-pitch (loop with interval.cnt = -1 for pitch = (first ambitus.midi) then (setq pitch (+ (nth interval.cnt intervals) pitch)) when (<= pitch (second ambitus.midi)) collect pitch into bag else return bag do (incf interval.cnt) when (= interval.cnt (length intervals)) do (setq interval.cnt 0)))) (gen-sieve-userdefined '(12 72) '(4 2 3))
  19. (gen-sieve '(c0 c9) (pitch-to-interval '(c4 e4 g4 bb4 c5)) :type :pitch) (gen-sieve (midi-to-pitch '(12 127)) (pitch-to-interval '(c4 e4 g4 bb4 c5)) :type :pitch) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; putted in a little function ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun gen-sequence (pitch-sequence midi-ambitus) (gen-sieve (midi-to-pitch midi-ambitus) (pitch-to-interval pitch-sequence) :type :pitch)) ;; eval (gen-sequence '(c4 e4 g4 bb4 c5) '(12 127)) ;; => (c0 e0 g0 bb0 c1 e1 g1 bb1 c2 e2 g2 bb2 c3 e3 g3 bb3 c4 e4 g4 bb4 c5 e5 g5 bb5 c6 e6 g6 bb6 c7 e7 g7 bb7 c8 e8 g8 bb8 c9 e9 g9)
  20. most of the time i'm working with pure LISP (pitches in midi-note-numbers -> then (midi-to-pitch ...) to create omn-pitches) after LISP-coding (generating lists for pitches/lengths/...) i'm converting to OMN-format by (make-omn :pitches :length etc...)...
  21. ALL-VARIANTS2 ********************** "extended version" -> if you want to have pairs of rest/length or if EVERY value could be changed (defun all-variants2 (seq &key (length/rest 'nil)) (let ((all-basic-binary-combinations) (binary-seq-completed)) ;;;decides if should work with pairs of length/rests (if (equal length/rest 't) ;; produces all combinations of 0/1 with length of (/ (length seq) 2) => your ON/OFF (switching values) (progn (setf all-basic-binary-combinations (loop for i from 0 to (binary-to-decimal (loop repeat (/ (length seq) 2) collect 1)) with val = '() do (setf val (decimal-to-binary i)) collect (append (loop repeat (- (/ (length seq) 2) (length val)) collect 0) val))) ;; combines the 1/0-list with 0 (for the unchanging rests) (setf binary-seq-completed (loop for x in all-basic-binary-combinations collect (loop for y in x append (list y 0))))) ;;;EVERY val will be switched (setf binary-seq-completed (loop for i from 0 to (binary-to-decimal (loop repeat (length seq) collect 1)) with val = '() do (setf val (decimal-to-binary i)) collect (append (loop repeat (- (length seq) (length val)) collect 0) val)))) ;; maps the "binary-seq-completed" on your values (loop for k in binary-seq-completed collect (loop for l in k for value in seq when (= l 1) collect (abs value) else collect value)))) (all-variants2 '(-1/4 -1/4 -1/4 -3/8 -1/4 -1/4) :length/rest 't) (all-variants2 '(-1/4 -1/4 -1/4 -3/8 -1/4 -1/4) :length/rest 'nil)
  22. (progn ;; your list with EVEN-length!!! (necessary for length/rest-structure) -> starting with all values as rests (setf seq '(-1/4 -1/4 -1/4 -3/8 -1/4 -1/4 -1/4 -3/8)) ;; produces all combinations of 0/1 with length of (/ (length seq) 2) => the number of your ON/OFF-vals (switching values, not the rests!) (setf all-basic-binary-combinations (loop for i from 0 to (binary-to-decimal (loop repeat (/ (length seq) 2) collect 1)) with val = '() do (setf val (decimal-to-binary i)) collect (append (loop repeat (- (/ (length seq) 2) (length val)) collect 0) ;; necessary "to fill" the seq-length val))) ;; combines the 1/0-list with 0 (for the unchanging rests) (setf binary-seq-completed (loop for x in all-basic-binary-combinations collect (loop for y in x append (list y 0)))) ;; maps the "binary-seq-completed" on your values (loop for k in binary-seq-completed collect (loop for l in k for value in seq when (= l 1) collect (abs value) else collect value))) ...is perhaps a way to get the output? ...evaluate... ...or press CMD2 -> so you see the rhythm-structure... ...in this version the gen-structure is based on the "BINARY-incf", if you want a RND-version, just "RND-ORDER" the list... packed in a function: (defun all-variants (seq) (let ((all-basic-binary-combinations) (binary-seq-completed)) ;; produces all combinations of 0/1 with length of (/ (length seq) 2) => your ON/OFF (switching values) (setf all-basic-binary-combinations (loop for i from 0 to (binary-to-decimal (loop repeat (/ (length seq) 2) collect 1)) with val = '() do (setf val (decimal-to-binary i)) collect (append (loop repeat (- (/ (length seq) 2) (length val)) collect 0) val))) ;; combines the 1/0-list with 0 (for the unchanging rests) (setf binary-seq-completed (loop for x in all-basic-binary-combinations collect (loop for y in x append (list y 0)))) ;; maps the "binary-seq-completed" on your values (loop for k in binary-seq-completed collect (loop for l in k for value in seq when (= l 1) collect (abs value) else collect value)))) (all-variants '(-1/4 -1/4 -1/4 -3/8 -1/4 -1/4 -1/4 -3/8))
  23. sorry, but i don't understand what you are looking for... you want to pick all elements > 0? or change rests into lengths and lengths into rests? like a kind of a filter?
  24. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; LENGTH-REST-RATIO ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; to TEST in a OMN- or LENGTH-sequence (defun length-rest-ratio (seq) (let ((liste (omn :length seq))) (loop for i in liste when (< i 0) sum (abs i) into -bag when (> i 0) sum i into +bag finally (return (ratio-to-float (* +bag (/ 1 (+ +bag -bag)))))))) (length-rest-ratio '(e. q. -q)) (length-rest-ratio '(-2 3 4 -1 -1)) (length-rest-ratio '(e. c4 ppp -q. q d3 e3 f3)) ;;; evaluate this test a few times (if (> (length-rest-ratio (rnd-repeat 10 '(1 2 3 4 -1 -2 -3 -4))) 0.5) (append 'more-lengths) (append 'more-rests))
×
×
  • Create New...

Important Information

Terms of Use Privacy Policy