; generate a single MIDI note

(defun make-note (start-time pitch dynamic length)
  (new midi 
    :time start-time
    :keynum pitch
    :duration length
    :amplitude dynamic))

; generate a MIDI chord from a list of pitches

(defun make-chord (start-time pitches dynamic length)
  (if (null pitches)
      nil
      (cons (make-note start-time (car pitches) dynamic length)
	    (make-chord start-time (cdr pitches) dynamic length))))

; generate a sequence of notes and chords from lists of onsets, pitches, dynamics, and durations

(defun make-phrase (start-time pitches dynamics lengths)
  (if (or (null pitches) (null dynamics) (null lengths))
      nil
      (if (listp (car pitches)) ; if the next element in "pitches" is a list, make a chord
	  (append (make-chord start-time (car pitches) (car dynamics) (car lengths))
		  (make-phrase (+ start-time (car lengths)) (cdr pitches) (cdr dynamics) (cdr lengths)))
	  (cons (make-note start-time (car pitches) (car dynamics) (car lengths))
		(make-phrase (+ start-time (car lengths)) (cdr pitches) (cdr dynamics) (cdr lengths))))))

(defun shrink-interval (interval)
  (* interval 0.5))

(defun shrink-intervals (interval-list)
  (mapcar #'shrink-interval interval-list))

(defun add-register (intervals registers)
  (if (or (null intervals) (null registers))
      nil
      (cons (+ (car intervals) (car registers))
	    (add-register (cdr intervals) (cdr registers)))))

(defparameter initial-intervals '(0 5 4 10 8 15 12 20 16 15 0 10 4 5 8 0 12))
(defparameter shrunk-intervals (append initial-intervals
				       (shrink-intervals initial-intervals)
				       (shrink-intervals (shrink-intervals initial-intervals))))
(defparameter shrunk-pitches (add-register shrunk-intervals (make-list 71 :initial-element 84)))
(defparameter shrunk-pitches-2 (add-register shrunk-intervals (make-list 71 :initial-element 97)))
(defparameter shrunk-pitches-3 (add-register shrunk-intervals (make-list 71 :initial-element 21)))

(defun random-scale (duration)
  (* duration (+ (random 0.4) 0.8)))

(defun alter-durations (duration-list)
  (mapcar #'random-scale duration-list)) 

(defparameter periodic-durations (make-list 17 :initial-element 0.8))
(defparameter scaled-durations (append periodic-durations
				     (alter-durations periodic-durations)
				     (alter-durations (alter-durations periodic-durations))))

(defun random-create-rests (dynamic)
  (if (> 0.1 (random 1.0))
      0.0
      dynamic))

(defun impose-random-rests (dynamic-list)
  (mapcar #'random-create-rests dynamic-list))

(defun random-create-accents (dynamic)
  (if (> 0.1 (random 1.0))
      0.9
      dynamic))

(defun impose-random-accents (dynamic-list)
  (mapcar #'random-create-accents dynamic-list))

(defparameter initial-dynamics (make-list 71 :initial-element 0.4))
(defparameter dynamics-plus-rests (impose-random-rests initial-dynamics))
(defparameter final-dynamics (impose-random-accents dynamics-plus-rests))

#| 
(events (append (make-phrase 0
			     shrunk-pitches
			     (impose-random-accents final-dynamics)
			     (alter-durations scaled-durations))
		(make-phrase 0 
			     shrunk-pitches-2 
			     (impose-random-rests dynamics-plus-rests)
			     (alter-durations scaled-durations))
		(make-phrase 0 
			     shrunk-pitches-3 
			     (impose-random-rests final-dynamics)
			     (alter-durations scaled-durations)))
	"test.mid")

|#