rnd-walk in a pitchfield with specific interval-control

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; rnd-walk in a pitchfield - with interval-control
;;;
;;; this is a little function which does an rnd-walk in a special way 
;;; the function is checking all possible interval-pairs first inside the pitchfield
;;; so that is on one hand all the time "inside" the pitchfield/sieve, but also only
;;; uses the :POSSIBLE-INTERVALS, so you could control the "interval-color" of the walk
;;; in an non-chromatic-pitchfield/sieve
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun enlarge-intervals (possible-intervals &key (octaves 2))
  (let ((possible-intervals (append possible-intervals 
                                    (loop repeat octaves
                                      for i = 12 then (incf i 12)
                                      append (x+b possible-intervals i)))))
    (append possible-intervals (neg! possible-intervals))))

;(enlarge-intervals '(2 3 4))

;;;;;;;;;;;

(defun special-rnd-walk (n &key pitchfield startpitch possible-intervals (interval-octaves 2))
  (let ((int-list (loop for i in pitchfield
                    collect (list (pitch-to-midi i) 
                                  (loop for x in pitchfield
                                    with int
                                    do (setf int (car (pitch-to-interval (list i x))))
                                    when (/= int 0)
                                    collect int))))
        (possible-intervals (enlarge-intervals possible-intervals :octaves interval-octaves)))

    (append 
     (list startpitch)
           (midi-to-pitch 
            (loop repeat n
              with int
              with pitch = (pitch-to-midi startpitch)
              do (setf int (rnd-pick (filter-preserve possible-intervals (cadr (assoc pitch int-list)))))
              when (null int)
              do (setf int (rnd-pick (cadr (assoc pitch int-list))))
              collect (setf pitch (pitch-to-midi (cadr (interval-to-pitch (list int) :start (midi-to-pitch pitch))))))))))



;;;;;;;;;;; EXAMPLES

;;; rnd-walk in a "chromatic-field" - as the most easiest example/way
;;; => so all possible-intervals could be used -> THE ORDINARY WAY... 

(special-rnd-walk 20 
                  :startpitch 'cs4
                  :pitchfield '(gs3 a3 bb3 b3 c4 cs4 d4 ds4 e4 f4 fs4 g4 gs4 a4)
                  :possible-intervals '(1 2 3))

;;; BUT have a look to the next examples!!!



;;; rnd-walk in a PITCHFIELD -> the function is checking all possible interval-pairs inside the pitchfield
;;; so that the rnd-walk INSIDE the PITCHFIELD could be done with specific intervals (if they are inside the field)

;;; COMPARE THE RESULT with the PITCHFIELD!!! 
;;; (setf pitchfield '(gs3 cs4 ds4 g4 a4 b4 d5 e5 fs5 bb5 c6 f6))

;;; "interval-color" of the walk is made with :possible-intervals
                        
(special-rnd-walk 5 
                  :startpitch 'ds4
                  :pitchfield '(gs3 cs4 ds4 g4 a4 b4 d5 e5 fs5 bb5 c6 f6)
                  :possible-intervals '(1 2 3)) ; + octaves of this intervals

(special-rnd-walk 10 
                  :startpitch 'ds4
                  :pitchfield '(gs3 cs4 ds4 g4 a4 b4 d5 e5 fs5 bb5 c6 f6)
                  :possible-intervals '(1 3 4 5)
                  :interval-octaves 0) ;;; reduced interval-span 

(special-rnd-walk 10 
                  :startpitch 'ds4
                  :pitchfield '(gs3 cs4 ds4 g4 a4 b4 d5 e5 fs5 bb5 c6 f6)
                  :possible-intervals '(5 6 7)) ; + octaves of this intervals

more examples -> SOUND

;;; rnd-versions so you will here the different interval-colors inside the pitchfield

(setf seq (gen-sieve '(f3 fs6) '(4 2 1 1 1 2 4 7) :type :pitch))
;(setf seq (gen-sieve '(f3 fs6) '(7 4 2 1 1 1 2 4) :type :pitch))
;(setf seq '(gs3 cs4 ds4 g4 a4 b4 d5 e5 fs5 bb5 c6 f6))



(setf pitchlist (special-rnd-walk (rnd-pick '(3 5 7 11)) 
                  :startpitch (rnd-pick seq)
                  :pitchfield seq
                  :possible-intervals (rnd-pick '((1 2) (3 4) (5 6 7)))
                  :interval-octaves 3))

(def-score intervals
           (:title "walk"
                   :key-signature 'atonal
                   :time-signature '(4 4)
                   :tempo 90)
  
  (instrument
   :omn (make-omn :pitch pitchlist
                  :length '(t)
                  :span :pitch)
   :channel 1
   :sound 'gm
   :program 'acoustic-grand-piano))

;;; rnd-walk in SIEVE only with intervals '(5 6 8)

(setf seq (gen-sieve '((c4 g7) (c2 g7)) '((2 1 10) (3 5)) :type :pitch))


(setf pitchlist (special-rnd-walk 30 
                  :startpitch (rnd-pick seq)
                  :pitchfield seq
                  :possible-intervals '(5 6 8)))


(def-score intervals
           (:title "intervals"
                   :key-signature 'atonal
                   :time-signature '(4 4)
                   :tempo 90)
  
  (instrument
   :omn (make-omn :pitch pitchlist
                  :length '(t)
                  :span :pitch)
   :channel 1
   :sound 'gm
   :program 'acoustic-grand-piano))

(setf seq (gen-sieve '((c2 g7) (c2 g7)) '((2 1 10) (3 5)) :type :pitch))

;;; EXAMPLE with changes -> all inside the same SIEVE

(setf pitchlist (append 
                 (special-rnd-walk 50 
                                   :startpitch (rnd-pick seq)
                                   :pitchfield seq
                                   :possible-intervals '(1)) ; minor second
                 (special-rnd-walk 50 
                                   :startpitch (rnd-pick seq)
                                   :pitchfield seq
                                   :possible-intervals '(2)) ; major second
                 (special-rnd-walk 50 
                                   :startpitch (rnd-pick seq)
                                   :pitchfield seq
                                   :possible-intervals '(3 4)) ;thirds
                 (special-rnd-walk 50 
                                   :startpitch (rnd-pick seq)
                                   :pitchfield seq
                                   :possible-intervals '(5 7)))) ; fourth-fifth 




(def-score intervals
           (:title "intervals"
                   :key-signature 'atonal
                   :time-signature '(4 4)
                   :tempo 90)
  
  (instrument
   :omn (make-omn :pitch pitchlist
                  :length '(t)
                  :span :pitch)
   :channel 1
   :sound 'gm
   :program 'acoustic-grand-piano))