goeyvaerts-rotation+

have fun or delete it...

chord-rotation by karel goeyvaerts (his early works), also used/modfied by stockhausen & co, etc...

regards

a.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;some OLD code -> changed for OMN ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;; goeyvaerts-rotation -> from "komposition 1";;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;; SUBS

(defun weighted-random (list)
  (loop for item in list
    with rand-num = (random (loop for x in list sum (second x)))
    for add = (second item) then (+ add (second item))
    when (< rand-num add) return (first item)))

;;;

(defun weighted-t/nil (on-weight)
  (let ((off-weight (- 1 on-weight)))
    (weighted-random (list (list 't on-weight) (list 'nil off-weight)))))


;;;

(defun single-pitch-transpose (pitch interval &key (midi-output 'nil))
  (if (numberp pitch)
    (if (equal midi-output 'nil)
      (midi-to-pitch (+ interval pitch))
      (+ interval pitch))
    (if (equal midi-output 'nil)
      (midi-to-pitch (+ interval (pitch-to-midi pitch)))
      (+ interval (pitch-to-midi pitch)))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;MAIN;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun goeyvaerts-rotation (&key pitches 
                                 static-pitches
                                 generations
                                 goeyvaerts-transpose-interval
                                 (direction 'up)
                                 low-border
                                 high-border
                                 correction-interval)
  (let ((pitches (filter-remove (pitch-to-midi static-pitches) (pitch-to-midi pitches))))
    (midi-to-pitch (append  (list (append pitches (pitch-to-midi static-pitches)))
                            (cond ((equal direction 'up)
                                   (loop repeat generations
                                     collect (append (setf pitches (append (loop for i in pitches
                                                                             when (> i (- (pitch-to-midi high-border) goeyvaerts-transpose-interval))
                                                                             collect (- i (- (abs correction-interval) 12))
                                                                             else collect (+ i goeyvaerts-transpose-interval))))
                                                     (pitch-to-midi static-pitches))))
                                  ((equal direction 'down)
                                   (loop repeat generations
                                     collect (append (setf pitches (append (loop for i in pitches
                                                                             when (< i (+ (pitch-to-midi low-border) goeyvaerts-transpose-interval))
                                                                             collect (+ i correction-interval 12)
                                                                             else collect (- i goeyvaerts-transpose-interval))))
                                                     (pitch-to-midi static-pitches)))))))))
      

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


(chordize (goeyvaerts-rotation :pitches '(cs2 a2 gs3 d4 bb4 a5 eb6)
                               :static-pitches '(d4)
                               :direction 'down
                               :generations 3
                               :goeyvaerts-transpose-interval 12
                               :low-border 'c2
                               :high-border 'c5
                               :correction-interval 24))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;put in in a specific interval-to-chord-function ;;;;;;;;;;;;;
;;;;;:type rnd-octaves or goeyvaerts ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



(defun interval-to-chord+ (&key interval-seq 
                               startpitch 
                               (generations 1)
                               (no-duplicates 'nil) 
                               (type 'rnd-octaves) 
                               (transpose-intervals '(-12 12))
                               (transpose-chance 0.5)
                               (arpeggiando 'nil)

                               (goeyvaerts-direction 'up)
                               (goeyvaerts-static-pitches '(c4))
                               (goeyvaerts-transpose-interval 12)
                               (goeyvaerts-low-border 'c2)
                               (goeyvaerts-high-border 'c5)
                               (goeyvaerts-correction-interval 24)

                               (sorted-asc 't))

                               
  (let ((pitches (interval-to-pitch interval-seq :start startpitch)))
    (setf pitches (if (equal no-duplicates 't)
                    (remove-duplicates pitches)
                    (append pitches)))
    
    (setf pitches 
                ;;type with rnd-octaves
          (cond ((equal type 'rnd-octaves)
                 (loop repeat generations 
                   collect (setf pitches (loop for i in pitches
                                           collect (single-pitch-transpose i (if (weighted-t/nil transpose-chance)
                                                                               (rnd-pick transpose-intervals)
                                                                               (append 0)))))))

                ;;type with goeyvaerts-transp -> (from "komposition 1")
                ((equal type 'goeyvaerts)
                 (goeyvaerts-rotation :pitches pitches
                                      :static-pitches goeyvaerts-static-pitches
                                      :direction goeyvaerts-direction
                                      :generations generations
                                      :goeyvaerts-transpose-interval goeyvaerts-transpose-interval
                                      :low-border goeyvaerts-low-border
                                      :high-border goeyvaerts-high-border
                                      :correction-interval goeyvaerts-correction-interval))
                
                (t (append pitches))))
    
    (if (equal sorted-asc 't)
      (setf pitches (sort-asc pitches)))
    (if (equal arpeggiando 't)
      (append pitches)
      (chordize pitches))))
  


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; examples ;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;; GOEYVAERTS
(pitch-list-plot
 (flatten (interval-to-chord+ :type 'goeyvaerts
                              :interval-seq '(5 3 3 3 5 3 3 3 5)
                              :generations 10
                              :startpitch 'c4 
                              :type 'goeyvaerts
                              :goeyvaerts-direction 'up
                              :goeyvaerts-low-border 'c2
                              :goeyvaerts-high-border 'c5
                              :goeyvaerts-correction-interval 48
                              :arpeggiando t
                              :sorted-asc 't)))

;;; RND-OCTAVES
(pitch-list-plot
 (flatten (interval-to-chord+ :type 'rnd-octaves
                              :interval-seq '(5 3 3 3 5 3 3 3 5)
                              :startpitch 'c4 
                              :type 'rnd-octaves
                              :no-duplicates 't
                              :transpose-intervals '(-12 12)
                              :transpose-chance 0.5
                              :arpeggiando t
                              :sorted-asc 't)))