; week-08.lisp
; creating pyramidal structures as in Aperghis' Recitations

; also working on creating gestural "templates" which can then be realized
; with shifting duration scales and a randomly evolving set of harmonies

; start-pyramid is the top-level function
; makes the first generation of the pyramid and then calls make-pyramid

(defun start-pyramid (generations gestures pitches)
  (if (or (<= generations 0) (null gestures) (null pitches))
      nil
      (write-midi 0 (make-pyramid (- generations 1)
				  gestures
				  (update-pitches pitches)
				  (make-gesture gestures pitches)))))

; make-pyramid recursively builds all generations of the pyramid after the first

(defun make-pyramid (generations gestures pitches previous-generation)
  (if (<= generations 0)
      nil
      (append previous-generation
	      (make-pyramid (- generations 1)
			    gestures
			    (update-pitches pitches)
			    (append (make-gesture gestures pitches)
				    previous-generation
				    (make-gesture gestures pitches))))))

; write-midi takes the final list of pyramid data and parses it as MIDI

(defun write-midi (current-time pyramid-list)
  (if (null pyramid-list)
      nil
      (append (write-chord current-time (car pyramid-list))
	      (write-midi (+ current-time (car (car pyramid-list)))
			  (cdr pyramid-list)))))

; write-chord is a helper function for write-midi - deals with single chords

(defun write-chord (current-time pyramid-value)
  (if (< (length pyramid-value) 3)
      nil
      (cons (new midi 
	      :time current-time
	      :duration (nth 0 pyramid-value)
	      :amplitude (nth 1 pyramid-value)
	      :keynum (nth 2 pyramid-value))
	    (write-chord current-time 
			 (cons (nth 0 pyramid-value)
			       (cons (nth 1 pyramid-value)
				     (cdddr pyramid-value)))))))

; update-pitches randomly alters values in a list of pitches
; to create harmonic variety over time

(defun update-pitches (pitch-list)
  (cond ((null pitch-list) nil)
	((< (random 1.0) 0.2)
	 (cons (+ (random 88) 21)
	       (update-pitches (cdr pitch-list))))
	(t (cons (car pitch-list)
		 (update-pitches (cdr pitch-list))))))

; make-gesture selects one gesture randomly from a list
; then calls render-gesture to generate specific content for that gesture

(defun make-gesture (gesture-list pitch-list)
  (if (or (null gesture-list) (null pitch-list))
      nil
      (render-gesture (nth (random (length gesture-list)) gesture-list)
		      pitch-list
		      (+ (random 1.0) 0.5))))

; render-gesture writes an ordered list of lists
; each sublist contains a duration, amplitude, and then one or many pitches

(defun render-gesture (gesture pitch-list duration-scaler)
  (if (null gesture)
      nil
      (cons (append (list (* (nth 1 (car gesture)) duration-scaler))
		    (list (nth 2 (car gesture)))
		    (render-chord (nth 0 (car gesture)) pitch-list))
	    (render-gesture (cdr gesture) pitch-list duration-scaler))))

; render-chord calculates the actual pitch content for each rendered gesture

(defun render-chord (number-notes pitch-list)
  (if (or (<= number-notes 0) (null pitch-list))
      nil
      (cons (nth (random (length pitch-list)) pitch-list)
	    (render-chord (- number-notes 1) (cdr pitch-list)))))

; gestures are ordered lists of triples - number of notes, duration, amplitude

(defparameter gesture-1 '((1 0.05 0.7) (3 0.2 0.8) 
			  (1 0.05 0.75) (4 0.2 0.85)
			  (1 0.05 0.8) (5 0.3 0.9)))
(defparameter gesture-2 '((5 0.25 0.6) (4 0.25 0.6)
			  (3 0.25 0.6) (2 0.25 0.6)
			  (1 0.35 0.6)))
(defparameter gesture-3 '((1 0.15 0.3) (1 0.15 0.3)
			  (1 0.15 0.3) (1 0.15 0.3)))
(defparameter gesture-4 '((1 0.05 0.7) (8 1.6 0.1)))
(defparameter gesture-5 '((10 3.5 0.4)))
(defparameter gesture-6 '((7 0.1 0.7) (6 0.18 0.6)
			  (5 0.32 0.5) (4 0.56 0.4)
			  (3 0.96 0.3) (2 1.6 0.2)
			  (1 2.56 0.1)))

; here's a master list of gestures

(defparameter gesture-list (list gesture-1 gesture-2 gesture-3 
				 gesture-4 gesture-5 gesture-6))

; and here's a bank of pitch material to begin with

(defparameter initial-pitches (list 36 37 38 60 62 64 66 72 75 78 84 85 86 88 103 104 105 106 107 108))

; this function calls renders a pyramid
; (events (start-pyramid 5 gesture-list initial-pitches) "test.mid")