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

;; 

;; THE CATHEDRAL 

;;

;; An example that uses simple stochastic matrix

;; to play a chord progression with chords represented as

;; pitch classes.

;;

;; Try adding a path to the matrix offering a potential 

;; modulation to a new key and another path back again :)

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

(au:clear-graph)

;Load Instrument

(define organ (au:make-node "aumu" "dls " "appl"))

(define reverb (au:make-node "aufx" "mrev" "appl"))

(au:connect-node reverb 0 *au:output-node* 0)

(au:connect-node organ 0 reverb 0)

(au:update-graph)

; send pipe organ program change to audio unit 

(au:midi-out (now) organ *io:midi-pc* 0 19 0)

; set cathedral reverb settings 

(au:set-param (now) reverb 0 0 0 100)

(au:set-param (now) reverb 1 0 0 86)

(au:set-param (now) reverb 2 0 0 0.028)

(au:set-param (now) reverb 3 0 0 0.09)

(au:set-param (now) reverb 4 0 0 0.015)

(au:set-param (now) reverb 5 0 0 0.001)

(au:set-param (now) reverb 6 0 0 0.5)

(au:set-param (now) reverb 7 0 0 1.0)

;; define some chords in c major as pitch classes 

(define *cmaj* '(0 4 7))

(define *cmaj-sus* '(0 5 7))

(define *dmin* '(2 5 9))

(define *emin* '(4 7 11))

(define *fmaj* '(5 9 0))

(define *gmaj* '(7 11 2))

(define *amin* '(9 0 4))

(define *bdim* '(11 2 4))

;; define stochastic chord matrix

;; this can be easily extended into a multi depth

;; markov matrix by replacing the car values with lists.

(define maj-matrix

   '((*cmaj* . (*dmin* *fmaj* *gmaj* *gmaj* *amin* *amin* *cmaj* *cmaj*))

     (*cmaj-sus* . (*cmaj* *cmaj* *cmaj* *dmin*))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          

     (*dmin* . (*gmaj* *gmaj* *dmin* *cmaj* *cmaj*))

     (*fmaj* . (*dmin* *gmaj* *gmaj* *dmin* *fmaj* *gmaj* *cmaj*))

     (*gmaj* . (*amin* *gmaj* *cmaj* *cmaj* *cmaj-sus*))

     (*amin* . (*gmaj* *fmaj* *fmaj* *fmaj* *dmin* *amin* *dmin* *dmin*))))

;; select random pitch from pitch class 

;; bounded by lower and upper (inclusive lower exclusive upper)

;;

;; arg 1: lower bound (inclusive) 

;; arg 2: upper bound (exclusive)

;; arg 3: pitch class

;;

;; returns -1 if no valid pitch was found 

;;

(define random-pc

   (lambda (lower upper pc)

      (if (null? pc) 

          -1

          (let loop ((val (random lower upper)) (count 0))

             (if (> count 50) 

                 -1                   

                 (if (memv (fmod val 12) pc) 

                     val

                     (loop (random lower upper) (+ count 1))))))))

;; creates a list of "number" pitches between "lower" and "upper" 

;; bounds from the given "pc".  a division of the bounds

;; by the number of elements requested breaks down the selection into

;; equal ranges from which each pitch is selected.

;; make-chord attempts to select pitches of all degrees of the pc.

;; it is possible for elements of the returned chord to be -1 if no 

;; possible pc is available for the given range. 

;;

;; arg1: lower bound (inclusive)

;; arg2: upper bound (exclusive)

;; arg3: number of pitches in chord 

;; arg4: pitch class 

;;

;; example: c7  

;; (make-chord 60 85 4 '(0 4 7 10)) => (60 70 76 79) 

;; 

(define make-chord

   (lambda (lower upper number pc)

      (let ((chord '()))

         (let loop ((l lower)

                    (u upper)

                    (n number)

                    (p pc))

            (if (< n 1) 

                (reverse chord) ; lowest pitch to highest pitch

                (let* ((range (- u l))

                       (gap (round (/ range n)))

                       (pitch (random-pc l (+ l gap) p)))

                   (if (< pitch 0) ; if new pitch is -1 try from whole pc

                       (set! chord (cons (random-pc l (+ l gap) pc) chord))

                       (set! chord (cons pitch chord)))

                   (loop (+ l gap)

                         u

                         (- n 1)

                         (if (> (length p) 1) 

                             (cl:remove (fmod (car chord) 12) p)

                             pc))))))))

;; chord progression with random lengths 

;; durations less than 2.0 to be 2 note chords

;; all others 5 note chords 

(define progression

   (lambda (time chord-sym)

      (let ((lgth (random '(0.5 0.5 0.5 0.5 1.0 1.0 1.5 2.0 2.0 4.0))))

         (map (lambda (p)

                 (play-note time organ 

                            p (+ 80 (random 20)) (* lgth *second* 0.9)))

              (make-chord (if (< lgth 2.0) 69 24) ; bottom of the chord 

                          80 ; top of the chord

                          (if (< lgth 2.0) 2 5) ; how many notes in the chord

                          (eval chord-sym))) ; pitch class to use for chord

         (callback (+ time (* lgth 40000)) progression 

                   (+ time (* lgth *second*))

                   (random (cdr (assoc chord-sym maj-matrix)))))))

(define stop

   (lambda ()

      (set! progression (lambda (time chord-sym) 'done))))

;; play organ 

(progression (now) '*cmaj*)