diff --git a/measureCounterEngraver.ily b/measureCounterEngraver.ily index 31405495ca3d3bdc24fe3501f20b6529bd00bf74..dfc2ad7a220dee67eb7f689c6f449c46b17c9222 100644 --- a/measureCounterEngraver.ily +++ b/measureCounterEngraver.ily @@ -1,3 +1,29 @@ +\version "2.15.40" + +% All this code was copied and adapted from lilypond's input/regression/scheme-text-spanner.ly +% The real measure counter engraver was done by David Nalesnik in April 2012 +% +#(define my-grob-descriptions '()) + +#(define my-event-classes (ly:make-context-mod)) + +defineEventClass = +#(define-void-function (parser location class parent) + (symbol? symbol?) + (ly:add-context-mod + my-event-classes + `(apply + ,(lambda (context class parent) + (ly:context-set-property! + context + 'EventClasses + (event-class-cons + class + parent + (ly:context-property context 'EventClasses '())))) + ,class ,parent))) + +\defineEventClass #'measure-counter-event #'span-event #(define (define-grob-property symbol type? description) (if (not (equal? (object-property symbol 'backend-doc) #f)) @@ -15,39 +41,6 @@ (counter ,integer? "initial number of a measure count") )) -#(define-event-class 'measure-counter-event - '(measure-counter-event - span-event - music-event - StreamEvent)) - -#(define measure-counter-types - '( - (MeasureCounterEvent - . ((description . "Used to signal the start and end of a measure counter.") - (types . (general-music measure-counter-event span-event event)) - )) - )) - -#(set! - measure-counter-types - (map (lambda (x) - (set-object-property! (car x) - 'music-description - (cdr (assq 'description (cdr x)))) - (let ((lst (cdr x))) - (set! lst (assoc-set! lst 'name (car x))) - (set! lst (assq-remove! lst 'description)) - (hashq-set! music-name-to-property-table (car x) lst) - (cons (car x) lst))) - measure-counter-types)) - -#(set! music-descriptions - (append measure-counter-types music-descriptions)) - -#(set! music-descriptions - (sort music-descriptions alist<?)) - #(define (add-grob-definition grob-name grob-entry) (let* ((meta-entry (assoc-get 'meta grob-entry)) (class (assoc-get 'class meta-entry)) @@ -69,11 +62,11 @@ (set! meta-entry (assoc-set! meta-entry 'interfaces ifaces-entry)) (set! grob-entry (assoc-set! grob-entry 'meta meta-entry)) - (set! all-grob-descriptions + (set! my-grob-descriptions (cons (cons grob-name grob-entry) - all-grob-descriptions)))) + my-grob-descriptions)))) -#(define (measure-counter-stencil grob) +#(define-public (measure-counter-stencil grob) (let* ((elts (ly:grob-object grob 'elements)) (refp (ly:grob-common-refpoint-of-array grob elts X)) (col-L (ly:spanner-bound grob LEFT)) @@ -103,6 +96,33 @@ text-script-interface font-interface)))))) +#(define measure-counter-types + '( + (MeasureCounterEvent + . ((description . "Used to signal the start and end of a measure counter.") + (types . (general-music measure-counter-event span-event event)) + )) + )) + +#(set! + measure-counter-types + (map (lambda (x) + (set-object-property! (car x) + 'music-description + (cdr (assq 'description (cdr x)))) + (let ((lst (cdr x))) + (set! lst (assoc-set! lst 'name (car x))) + (set! lst (assq-remove! lst 'description)) + (hashq-set! music-name-to-property-table (car x) lst) + (cons (car x) lst))) + measure-counter-types)) + +#(set! music-descriptions + (append measure-counter-types music-descriptions)) + +#(set! music-descriptions + (sort music-descriptions alist<?)) + measureCounterEngraver = #(lambda (context) (let ((span '()) @@ -172,7 +192,8 @@ measureCounterEnd = \layout { \context { \Global - \grobdescriptions #all-grob-descriptions + \grobdescriptions #my-grob-descriptions + #my-event-classes } \context{ \Staff