On 09/05/2016 05:01 AM, Marc Hohl wrote:
Has someone else already done something like this? I have no experience
in writing scheme engravers, so any hint would be highly appreciated.
lilypond-html-live-score does something like this by post-processing an
SVG with python to add meta data to the grobs in the SVG file:
https://gitlab.com/sigmate/lilypond-html-live-score/blob/master/make-live-score#L88
I was working on porting part of that to scheme so it could be done
directly. I've attached my include file. It will currently display the
total duration to the log. It could be simplified in various ways if it
was calculating just the total duration and not adding timing info to
every grob.
It's still a work in progress and only lightly tested.
-Paul
\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
(/ 60 (* metronome-count
(string->number
(ly:duration->string tempo-unit)))))
#f)))
(define (recurse prev-moment prev-time prev-rate grob 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* ((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? grobs)
time
(recurse moment time rate (car grobs) (cdr grobs) (if rate-change
(cdr
tempo-changes)
tempo-changes)))))
;; an engraver with a closure
(let ((grobs '())
(metronome-mark-grobs '())
(note-head-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)))
((note-head-interface engraver grob source-engraver)
(set! note-head-grobs (cons grob note-head-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)))))
;; the initial tempo rate (0.25) is 60 divided
;; by (60 metronome-count times 4 tempo-unit)
(total-time (recurse 0 0 0.25
(car grobs-sorted) (cdr grobs-sorted)
tempo-changes-sorted)))
(display (exact->inexact total-time))
;; 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)))
(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
}
}
_______________________________________________
lilypond-user mailing list
lilypond-user@gnu.org
https://lists.gnu.org/mailman/listinfo/lilypond-user
