;;;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))))
  


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

 

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

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

We will make even better :-)