\version "2.19.42"

#(define Grob_meta_data_engraver
   (lambda (context)

     (define (get-tempo-change metronome-mark-grob)
       "Returns a pair (moment-fraction . new-tempo-rate) or #f."
       (let*
        ((grob-cause (ly:grob-property metronome-mark-grob 'cause))
         (metronome-count (ly:event-property grob-cause 'metronome-count))
         (tempo-unit (ly:event-property grob-cause 'tempo-unit))
         (moment (grob::when metronome-mark-grob)))
        (if (and metronome-count tempo-unit)
            (cons
             (ly:moment-main moment)
             ;; calculate the new tempo rate
             (/ (string->number
                 (ly:duration->string tempo-unit))
               metronome-count))
            #f)))


     (define (recurse prev-moment prev-time prev-rate grobs tempo-changes)
       "Recursive function to calculate and set timing data for grobs.
        Calculates the actual timing of grobs, honoring tempo changes.
        Returns the total time for the score."
       (let* ((grob (car grobs))
              (moment (ly:moment-main (grob::when grob)))
              (rate-change (if (pair? tempo-changes)
                               (> moment (caar tempo-changes))
                               #f))
              (rate (if rate-change
                        (cdr (car tempo-changes))
                        prev-rate))
              (time (if (= moment prev-moment)
                        prev-time
                        (+ prev-time (* rate (- moment prev-moment)))))
              (id-string (string-append
                          (ly:format "class:ly grob ~a" (grob::name grob))
                          (ly:format ";data-moment:~a" (exact->inexact moment))
                          (ly:format ";data-measure:~a" (car (grob::rhythmic-location grob)))
                          (ly:format ";data-real-time:~a" time)
                          )))

         ;; (display id-string)(newline)
         (ly:grob-set-property! grob 'id id-string)

         ;; recurse or return total time if we are done
         (if (null? (cdr grobs))
             time
             (recurse moment time rate (cdr grobs) (if rate-change
                                                       (cdr tempo-changes)
                                                       tempo-changes)))))


     ;; an engraver with a closure
     (let ((grobs '())
           (metronome-mark-grobs '()))
       (make-engraver

        ;; acknowledgers collect grobs
        (acknowledgers
         ((grob-interface engraver grob source-engraver)
          (set! grobs (cons grob grobs)))

         ((metronome-mark-interface engraver grob source-engraver)
          (set! metronome-mark-grobs (cons grob metronome-mark-grobs))))

        ;; finalize stage, calculate and store data on grobs
        ((finalize translator)
         (let*
          ((tempo-changes (filter pair? (map get-tempo-change metronome-mark-grobs)))

           (tempo-changes-sorted (sort-list! tempo-changes
                                   (lambda (a b) (< (car a) (car b)))))

           (grobs-sorted (sort-list! (filter grob::name grobs)
                           (lambda (a b)
                             (ly:moment<? (grob::when a) (grob::when b)))))
           ;; initial tempo rate (1/15) is (4 tempo-unit / 60 metronome-count)
           (total-time (recurse 0 0 1/15 grobs-sorted tempo-changes-sorted))

           (minutes (floor total-time))
           ;; Is using floor correct?
           (seconds (floor (* (- total-time minutes ) 60)))
           (duration-string
            (format #f "Total duration: ~a:~2,,,'address@hidden" minutes seconds))

           (note-head-grobs
            (filter (lambda (grob) (grob::has-interface grob 'note-head-interface))
                    grobs)))

          (display duration-string)

          ;; add additional data for MetronomeMark grobs
          (for-each (lambda (metronome-mark-grob)
                      (let* ((grob-cause (ly:grob-property metronome-mark-grob 'cause))
                             (text-prop (ly:event-property grob-cause 'text))
                             (text-string (if (not (null? text-prop))
                                              (ly:format ";data-text:~a" text-prop)
                                              ""))
                             (id-string (ly:grob-property metronome-mark-grob 'id)))
                        (ly:grob-set-property! metronome-mark-grob 'id
                          (string-append id-string text-string))))
            metronome-mark-grobs)

          ;; add additional data for NoteHead grobs
          (for-each (lambda (note-head-grob)
                      (let* ((grob-cause (ly:grob-property note-head-grob 'cause))
                             (pitch-prop (ly:event-property grob-cause 'pitch))
                             (pitch-string (if (ly:pitch? pitch-prop)
                                               (ly:format ";data-pitch:~a"
                                                 (ly:pitch-semitones pitch-prop))
                                               ""))
                             (id-string (ly:grob-property note-head-grob 'id)))
                        
                        ;; (display pitch-string)(newline)
                        
                        (ly:grob-set-property! note-head-grob 'id
                          (string-append id-string pitch-string))))
            note-head-grobs)
          ))))))


\layout {
  \context {
    \Score
    \consists \Grob_meta_data_engraver
  }
}