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

;;

;; MUSICXML

;; 

;; Plays back a MUSICXML file.  make sure you have evaluated

;; the xml library (example 35) before running this example 

;;

;; This is a quick example to demonstrate the xml library

;; not a full musicxml parser. expect the unexpected! 

;;

;; Don't forget to change the files path to a valid musicxml file! 

;;

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

(au:clear-graph)

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

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

(au:update-graph)

(define *str-pitch-map*

   `(("C" . 0)

     ("D" . 2)

     ("E" . 4)

     ("F" . 5)

     ("G" . 7)

     ("A" . 9)

     ("B" . 11)))

(define parse-measure

   (lambda (notes div transpose)

      (list (map (lambda (note)

                    (if (string=? "backup" (xml:get-node-name note))

                        'backup

                        (let* ((step (objc:nsarray->list (xml:xpath note "pitch/step/text()")))

                               (rest (objc:nsarray->list (xml:xpath note "rest")))

                               (octave (objc:nsarray->list (xml:xpath note "pitch/octave/text()")))

                               (alter (objc:nsarray->list (xml:xpath note "pitch/alter/text()")))

                               (adjust (if (null? alter) 0 

                                           (string->number (xml:get-node-value (car alter))))))

                           (if (null? rest)

                               (+ 12 adjust transpose 

                                  (* 12 (string->number (xml:get-node-value (car octave))))

                                  (cdr (assoc (xml:get-node-value (car step)) *str-pitch-map*)))

                               -1))))

                 notes)

            (map (lambda (note)

                    (let* ((dur (objc:nsarray->list (xml:xpath note "duration/text()")))

                           (chord (objc:nsarray->list (xml:xpath note "chord"))))

                       (if (null? dur) 

                           (set! dur 0) 

                           (set! dur (/ 1.0 (/ div (string->number (xml:get-node-value (car dur)))))))

                       (if (null? chord) dur (* -1 dur))))

                 notes))))

(define parse-part

   (lambda (part) 

      (let ((div-g 1)

            (transpose-g 0))

         (map (lambda (measure)

                 (let ((div (objc:nsarray->list (xml:xpath measure "attributes/divisions/text()")))

                       (num (objc:nsarray->list (xml:xpath measure "attributes/time/beats/text()")))

                       (den (objc:nsarray->list (xml:xpath measure "attributes/time/beat-type/text()")))

                       (transpose (objc:nsarray->list (xml:xpath measure "attributes/transpose/chromatic/text()")))

                       (notes (objc:nsarray->list (xml:xpath measure "note|backup"))))   

                    (if (not (null? div))

                        (set! div-g (string->number (xml:get-node-value (car div)))))

                    (if (not (null? transpose))

                        (set! transpose-g (string->number (xml:get-node-value (car transpose)))))                 

                    (if (not (null? notes))

                        (parse-measure notes div-g transpose-g))))

              (objc:nsarray->list (xml:xpath part "measure"))))))

(define parse-score

   (lambda (xmlscore)

      (map parse-part (objc:nsarray->list (xml:xpath xmlscore "/score-partwise/part")))))

(define player

   (lambda (time part)

      (let loop ((measures part))

         (cond ((null? measures) 'done)

               (else (for-each (lambda (p d)

                                  (if (symbol? p) 

                                      (set! time (- time (* *second* d)))

                                      (begin (play-note time piano p 80 (* *second* (abs d)))

                                             (if (positive? d) (set! time (+ time (* *second* d)))))))

                               (caar  measures)

                               (cadar measures))

                     (callback (- time *second*) loop (cdr measures)))))))

(define start

   (lambda (time path)

      (for-each (lambda (part)

                   (player time part))

                (parse-score (xml:load-document path)))))

(callback (+ (now) (* 2 *second*)) start 

          (+ (now) (* *second* 4)) "/tmp/score.xml")