; wildly simplified quasi-Ferneyhough-type layering of processes expressed in CM
; updated lcb 11.12.20007

; shift contents of a list one element to the left
(defun rotate-left (input-list)
  (append (cdr input-list) (list (car input-list))))

; remove the beginning and ending values of a list
(defun truncate-ends (input-list)
  (reverse (cdr (reverse (cdr input-list)))))

; transpose a list of pitch-classes by a list of intervals 
(defun stretch-intervals (pitches intervals)
  (if (and pitches intervals)
    (cons (+ (car pitches) (car intervals))
          (stretch-intervals (cdr pitches) (cdr intervals)))))

; transpose a list of pitch-classes by a list of octave changes
; where 0 is middle c, positive numbers are octaves above middle c, 
; and negative numbers below middle c
(defun set-register (pitches octave-changes)
  (if (and pitches octave-changes)
    (cons (+ 60 (car pitches) (* 12 (car octave-changes)))
          (set-register (cdr pitches) (cdr octave-changes)))))

; create a periodic sequence of durations
(defun make-impulses (start-onset impulse-duration impulses)
  (if (> impulses 0)
    (cons (float start-onset)
          (make-impulses (+ start-onset impulse-duration) impulse-duration (- impulses 1)))))

; fit a periodic rhythmic sequence to a specific duration
(defun fit-impulses (start-onset duration impulses)
  (make-impulses start-onset (/ duration impulses) impulses))

; fit periodic rhythmic sequences to a list of specific durations
(defun fill-structure (time-structure impulse-structure start-onset)
  (if (and time-structure impulse-structure)
    (append (fit-impulses start-onset (car time-structure) (car impulse-structure))
            (fill-structure (cdr time-structure)
                            (cdr impulse-structure)           
                            (+ start-onset (car time-structure))))))

; process a list of rhythms and create corresponding amplitudes
; make high-amplitude events whenever there are multiple impulses in a given duration
(defun make-velocities (impulse-structure high-velocity low-velocity)
  (if impulse-structure
    (if (> (car impulse-structure) 1)
      (cons high-velocity
            (make-velocities (cons (- (car impulse-structure) 1)
                                   (cdr impulse-structure))
                             high-velocity
                             low-velocity))
      (cons low-velocity
            (make-velocities (cdr impulse-structure) high-velocity low-velocity)))))

; apply rests to an existing list of velocities
(defun impose-rests (velocities impulse-structure)
  (if (and velocities impulse-structure)
    (if (> (random 1.0) 0.15)
      (cons (car velocities)
            (impose-rests (cdr velocities) (cons (- (car impulse-structure) 1) (cdr impulse-structure))))
      (cons 0 (impose-rests (cdr velocities) (cdr impulse-structure))))))

; combine pitch, rhythm, and velocity lists to make a MIDI sequence
(defun make-results (pitches rhythms velocities)
  (if (and pitches rhythms velocities (cdr rhythms))
    (cons (new midi
            :keynum (car pitches)
            :time (car rhythms)
            :duration (- (cadr rhythms) (car rhythms))
            :amplitude (car velocities))
          (make-results (cdr pitches) (cdr rhythms) (cdr velocities)))))

; parameter definitions for pitch
(defparameter pitch-gesture (list 4 5 1 7 3 4 0 9 8 6 11))
(defparameter interval-change (list 0 1 0 -1 0 3 2 1 -1 0 -3))
(defparameter pitches 
	(append (set-register pitch-gesture interval-change)
            (set-register (stretch-intervals (truncate-ends (rotate-left pitch-gesture))
                                             (rotate-left interval-change))
                          interval-change)
            (set-register (stretch-intervals (truncate-ends 
				(rotate-left (truncate-ends pitch-gesture)))
                                             (truncate-ends (rotate-left interval-change)))
                                      (rotate-left (truncate-ends interval-change)))))
(defparameter more-pitches 
	(append pitches (stretch-intervals (truncate-ends (rotate-left (truncate-ends pitches)))
                                       (stretch-intervals pitch-gesture interval-change))))

; parameter definitions for rhythm
(defparameter time-list (list 0.3 0.7 0.3 0.4 0.2 0.9 0.2 0.3 0.4 0.5 0.1 1.1))
(defparameter impulse-list (list 5 4 3 2 6 5 3 1 7 4 1 8 4 9 4))
(defparameter rhythms (fill-structure time-list impulse-list 0))

; parameter definitions for amplitude
(defparameter velocities (impose-rests (make-velocities (rotate-left impulse-list) 120 70) 
                                 (rotate-left (rotate-left impulse-list))))

; call to (events) to generate output
; (events (make-results more-pitches rhythms velocities) "test.mid")