gen-sub-structure

[AM]

;;;GEN-SUB-STRUCTURE;;; andré meier - 01.05.2016

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;in a given OMN-pitch/duration/articulation-structure -> stream (in events)
;;;you could build a sub-structure from another pitch-seq (:sub-pitch-structure)
;;;it changes the duration and the articulation and the velocity
;;;if  keyword ":sieve 't" -> all other pitches/lengths will be replaced by rests,
;;;a bit like LACHENMANN generates his "strukturnetze"

;;;p.s. i coded this event-structure because it's more practical for my recent project ... 
;;;and i think it's a very practical DATA-structure... it would be also possible to build
;;;the events by defstructure-function.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;book:
;;;http://www.editionargus.de/pd1086682662.htm?defaultVariants={EOL}&categoryId=5

;;;a link to an analytical work -> also with OM-patches (does anybody could change it for opusmodus-use?)!
;;;http://icem-www.folkwang-uni.de/icem-web/wp-content/uploads/2004/07/

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; example 1
(setq pitches (midi-to-pitch '(60 61 62 63 64 65 66 67 68 69 70 71)))
(setq durations (gen-length '(1 2 3 4 5 6 7 6 5 4 3 2) 1/32))
(setq velocities (loop repeat (length pitches) collect (rnd-pick '(ppp pp p))))
      
(setq sub-structure (midi-to-pitch '(67 66 65 64 63 62)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; example 2
(setq pitches (midi-to-pitch '(60 61 62 63 64 65 66 67 68 69 70 71)))
(setq durations (gen-length '(1 2 3 4 5 6 7 6 5 4 3 2  3 4 5 6 7 6 5 4 3 2 3 4 5 6 7 6 5 4 3 2) 1/64))
(setq velocities (loop repeat (length pitches) collect (rnd-pick '(ppp))))

(setq sub-pitch-structure (midi-to-pitch '(67 68 66 62 63 63  65 64 63 66 62  65 64)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;gen an event-stream
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(setq event-stream (gen-events-from-lists :durations durations
                                          :pitches pitches
                                          :velocities velocities))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;gen-sub-structure + gen-ordinary-omn
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(gen-ordinary-omn
 (gen-sub-structure :sieve 't ;;when T, only the sub-structure pitches will be shown, other vals = rests (a bit like lachenmann-"strukturnetz")
                    :in-cycles 't ;; when T, the basic-pitch-seq will be repeated until all the sub-pitches were matched 
                    :event-stream event-stream
                    :sub-pitch-structure sub-structure
                    :replace-duration-factor 2 ;; factor who changes the duration when match
                    :replace-articulation 'trem
                    :replace-velocity 'f))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;subfunctions;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun build-event (&key duration (pitch 'nil) (velocity 'nil) (articulation 'nil) (optional_data1 'nil) (optional_data2 'nil) (optional_data3 'nil))
  (list duration pitch velocity articulation optional_data1 optional_data2 optional_data3))

;;;;;;;;;;;;;;

(defun gen-events-from-lists (&key durations pitches  (velocities nil) (articulations nil) (optional_datas1 nil) (optional_datas2 nil) (optional_datas3 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_datas1)
                  (nth cnt2 optional_datas2)
                  (nth cnt2 optional_datas3)
                  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)))


(gen-events-from-lists :durations '(1 -2 3 4 -5 4 3 2 1 2 3 2 2 3 3 2)
                       :pitches '(60 61 62 63 64 65 66 67 68 69 70 71)
                       :velocities '(mf ff fff ff))

;;;;;;;;;;;;;;


(defun gen-sub-structure (&key (in-cycles 'nil) (sieve 'nil) event-stream sub-pitch-structure (replace-duration-factor 10) replace-articulation (replace-velocity 'mf))
  (if (equal in-cycles 'nil)
    (loop for i in event-stream
      with cnt = 0
      when (equal (second i) (nth cnt sub-pitch-structure))
      collect (list (* replace-duration-factor (first i)) 
                    (second i) 
                    replace-velocity
                    replace-articulation 
                    (fifth i) 
                    (sixth i) 
                    (seventh i) 
                    (eighth i))
      and do (incf cnt)
      else collect (if (equal sieve 't)
                     (list (* (abs (first i)) -1)
                           nil nil nil nil nil nil (eighth i))
                     (flatten (list i))))
    
    (loop repeat (length sub-pitch-structure)
      with cnt = 0
      append (loop for i in event-stream
               when (equal (second i) (nth cnt sub-pitch-structure))
               collect (list (* replace-duration-factor (first i)) 
                             (second i) 
                             replace-velocity
                             replace-articulation 
                             (fifth i) 
                             (sixth i) 
                             (seventh i) 
                             (eighth i))
               and do (incf cnt)
               else collect (if (equal sieve 't)
                              (list (* (abs (first i)) -1)
                                                       nil nil nil nil nil nil (eighth i))
                              (flatten (list i)))))))

;;;;;;;;;;;;;;

(defun gen-ordinary-omn (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))))
  


;;;;;;;;;;;;;;

 

[opmo]

I will have a look into it more in details after we finish the velocity functions.

[AM]

OPUSMODUS is nearly perfect for me and my work! thanks for your great work, janusz and ?!!!

[opmo]

We will make even better :-)