Jump to content

AM

Members
  • Posts

    792
  • Joined

  • Last visited

Posts posted by AM

  1. i see, it's okay for THIS case! but for other rnd-generated-rhythm-structures it don't work...

    ...to insert something like (app - gs4) ... in cases like

     '(w_5h. f5 pppp ord (app - gs4) 5q g5 ppp ord)

    the (app - ...)-solution also don't work properly

     

    but thanx

    andré

  2. dear janusz
    this XML-layout is strange - when i try to inserting appoggiaturas or acciaccaturas in sequences with tuplets

     

    example:

    '(5q fs3 pppp ord -5d.q 5q d4 ppp ord -q 5h g4 ff ord (app e e4 fs4 gs4 f4) 5q e4 ppp ord -5q 5q b4 ff ord 5q a4 ff ord -5d.. 5q fs4 ppp ord (app e e4 fs4 gs4 f4) 5q e4 ppp ord -5ddq 5q fs4 ppp ord -5w.. 5q gs4 ppp ord -5h 5q f4 ff ord 5q eb4 ff ord -5h. 5q g4 ff ord -5w -5q 5w e5 pppp ord)

    also like that with 1/12 etc...

     

    thanx

    andré

  3. great thing!

    for me it's important to have the voice-symbol also in (single-events omn-list), and to read it like (omn :voice omn-list), and (voicep  omn-list)

     

    greetings

    andré 

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

     

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

     

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

     

  7. 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é

     

     

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

     

  9. 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...

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

     

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

     

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

     

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

     

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

     

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

     

×
×
  • Create New...

Important Information

Terms of Use Privacy Policy