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

;;

;; PLAY A BACH 4 PART CHORALE

;;

;; NOTE: You will need to point the 

;; (io:read-midi-file "somefile.mid") function to 

;; a valid 4 part midi file.

;;

;; You can download a chorale from here

;; http://mapage.noos.fr/dardelf/musique/BWV645.mid

;;

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

;; Make sure that no audio units are already connected

(au:clear-graph)

;; setup audio unit graph

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

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

(au:update-graph)

;; send program change to dls audio units

(au:midi-out (now) synth *io:midi-pc* 0 68 0) ; oboe

(au:midi-out (now) synth *io:midi-pc* 1 71 0) ; clarinet

(au:midi-out (now) synth *io:midi-pc* 2 60 0) ; horn

(au:midi-out (now) synth *io:midi-pc* 3 70 0) ; bassoon

;; read midi file

(define chorale (io:read-midi-file "/tmp/bach.mid"))

;; marker

; Events can have a marker number attached to them

; to allow us to mute/ignore them even after they have been

; scheduled. (See below).

(define marker 100)

;; Play a MIDI track

; The list-ref function is an Impromptu function that 

; allows the acceesing of elements within a list by index.

; The consing of the play-note time and marker attaches

; the marker number of the note events (start and stop).

(define (play-seq time inst midi-track chan)

   (map (lambda (t p v r)

           (play-note (cons (+ time (* t *second*)) marker) inst p v (* r *second*) chan))

        (list-ref midi-track 0)

        (list-ref midi-track 1)

        (list-ref midi-track 2)

        (list-ref midi-track 3)))

;; Play the first four tracks

(define (chorale-player time score)

   (play-seq time synth (list-ref score 3) 0)

   (play-seq time synth (list-ref score 2) 1)

   (play-seq time synth (list-ref score 1) 2)

   (play-seq time synth (list-ref score 0) 3))

;; Start - give play-seq 2 seconds to load the file.

(chorale-player (+ (now) (* *second* 2)) chorale)

;; Mute

; Blocking all events with this marker number means

; they will be ignored (not played).

(sys:set-block marker)

;; stuck notes?

; It is not uncommon for the sys:set-block function to 

; take effect during a note such that it started 

; but did not get a stop event - and is stuck on.

; The panic function sends a stop command to all notes.

; The "do" function first assigns a variable, followed by

; the conditions under which it is varied each repetition, 

; then its stop condition and, finally, the commnds to execute

; each repetition.

(define panic

   (lambda (inst)

      (do ((ch 0 (if (= ch 16) 0 (+ ch 1)))

           (i 0 (if (= ch 0) (+ i 1) i)))

          ((= i 127) '())

        (stop-note (now) inst i ch))))

(panic synth)

;; Unmute

; Removing the block means the events will no longer be ignored.

(sys:remove-block marker)