3 % All this code was copied and adapted from lilypond's input/regression/scheme-text-spanner.ly
\r
4 % The real measure counter engraver was done by David Nalesnik in April 2012
\r
6 #(define my-grob-descriptions '())
\r
8 #(define my-event-classes (ly:make-context-mod))
\r
11 #(define-void-function (parser location class parent)
\r
16 ,(lambda (context class parent)
\r
17 (ly:context-set-property!
\r
23 (ly:context-property context 'EventClasses '()))))
\r
26 \defineEventClass #'measure-counter-event #'span-event
\r
28 #(define (define-grob-property symbol type? description)
\r
29 (if (not (equal? (object-property symbol 'backend-doc) #f))
\r
30 (ly:error (_ "symbol ~S redefined") symbol))
\r
32 (set-object-property! symbol 'backend-type? type?)
\r
33 (set-object-property! symbol 'backend-doc description)
\r
38 (apply define-grob-property x))
\r
41 (counter ,integer? "initial number of a measure count")
\r
44 #(define (add-grob-definition grob-name grob-entry)
\r
45 (let* ((meta-entry (assoc-get 'meta grob-entry))
\r
46 (class (assoc-get 'class meta-entry))
\r
47 (ifaces-entry (assoc-get 'interfaces meta-entry)))
\r
48 (set-object-property! grob-name 'translation-type? list?)
\r
49 (set-object-property! grob-name 'is-grob? #t)
\r
50 (set! ifaces-entry (append (case class
\r
51 ((Item) '(item-interface))
\r
52 ((Spanner) '(spanner-interface))
\r
53 ((Paper_column) '((item-interface
\r
54 paper-column-interface)))
\r
55 ((System) '((system-interface
\r
56 spanner-interface)))
\r
57 (else '(unknown-interface)))
\r
59 (set! ifaces-entry (uniq-list (sort ifaces-entry symbol<?)))
\r
60 (set! ifaces-entry (cons 'grob-interface ifaces-entry))
\r
61 (set! meta-entry (assoc-set! meta-entry 'name grob-name))
\r
62 (set! meta-entry (assoc-set! meta-entry 'interfaces
\r
64 (set! grob-entry (assoc-set! grob-entry 'meta meta-entry))
\r
65 (set! my-grob-descriptions
\r
66 (cons (cons grob-name grob-entry)
\r
67 my-grob-descriptions))))
\r
69 #(define-public (measure-counter-stencil grob)
\r
70 (let* ((elts (ly:grob-object grob 'elements))
\r
71 (refp (ly:grob-common-refpoint-of-array grob elts X))
\r
72 (col-L (ly:spanner-bound grob LEFT))
\r
73 (col-R (ly:spanner-bound grob RIGHT))
\r
74 (left-self-ext (ly:grob-extent col-L col-L X))
\r
75 (left-ext (ly:grob-extent col-L refp X))
\r
76 (right-ext (ly:grob-extent col-R refp X))
\r
77 (counter (ly:grob-property grob 'counter))
\r
78 (num (grob-interpret-markup grob (markup (number->string counter)))))
\r
80 (set! num (ly:stencil-aligned-to num X CENTER))
\r
81 (set! num (ly:stencil-translate-axis num (cdr left-self-ext) X))
\r
82 (set! num (ly:stencil-translate-axis num (* 0.5 (- (car right-ext) (cdr left-ext))) X))
\r
86 #(add-grob-definition
\r
91 (outside-staff-priority . 350) ; what should this be?
\r
92 (stencil . ,measure-counter-stencil)
\r
93 (font-encoding . 'feta-text )
\r
94 (meta . ((class . Spanner)
\r
95 (interfaces . (text-interface
\r
96 text-script-interface
\r
97 font-interface))))))
\r
99 #(define measure-counter-types
\r
101 (MeasureCounterEvent
\r
102 . ((description . "Used to signal the start and end of a measure counter.")
\r
103 (types . (general-music measure-counter-event span-event event))
\r
108 measure-counter-types
\r
110 (set-object-property! (car x)
\r
112 (cdr (assq 'description (cdr x))))
\r
113 (let ((lst (cdr x)))
\r
114 (set! lst (assoc-set! lst 'name (car x)))
\r
115 (set! lst (assq-remove! lst 'description))
\r
116 (hashq-set! music-name-to-property-table (car x) lst)
\r
117 (cons (car x) lst)))
\r
118 measure-counter-types))
\r
120 #(set! music-descriptions
\r
121 (append measure-counter-types music-descriptions))
\r
123 #(set! music-descriptions
\r
124 (sort music-descriptions alist<?))
\r
126 measureCounterEngraver =
\r
131 (last-measure-seen 0)
\r
136 (measure-counter-event .
\r
137 ,(lambda (engraver event)
\r
138 (set! last-measure-seen (ly:context-property context 'currentBarNumber))
\r
139 (set! new-measure? #t)
\r
140 (if (= START (ly:event-property event 'span-direction))
\r
148 (let ((col (ly:context-property context 'currentCommandColumn))
\r
149 (now (ly:context-property context 'measurePosition))
\r
150 (current-bar (ly:context-property context 'currentBarNumber)))
\r
151 ; if spanner has been started, make sure we're in a new bar before adding to it
\r
152 (if (and (pair? span) (> current-bar last-measure-seen))
\r
153 (set! new-measure? #t))
\r
156 (if (moment<=? now ZERO-MOMENT) ; first column of measure
\r
158 (if (and stop? (pair? span))
\r
160 (ly:spanner-set-bound! (last span) RIGHT col)
\r
161 (ly:pointer-group-interface::add-grob (last span) 'elements col)
\r
162 (ly:engraver-announce-end-grob trans (last span) col)
\r
168 ; add a right bound to the current spanner
\r
171 (ly:spanner-set-bound! (last span) RIGHT col)
\r
172 (ly:pointer-group-interface::add-grob (last span) 'elements col)
\r
173 (ly:engraver-announce-end-grob trans (last span) col)))
\r
174 ; make a new spanner with the same column as left bound
\r
175 (let* ((x (ly:engraver-make-grob trans 'MeasureCounter col))
\r
176 (counter (ly:grob-property x 'counter)))
\r
177 (ly:spanner-set-bound! x LEFT col)
\r
178 (ly:pointer-group-interface::add-grob x 'elements col)
\r
179 (set! (ly:grob-property x 'counter) (+ counter increment))
\r
180 (set! span (append span (list x)))
\r
181 (set! increment (1+ increment)))))))
\r
182 (set! new-measure? #f)))
\r
183 (set! last-measure-seen current-bar)))))))
\r
186 measureCounterStart =
\r
187 #(make-span-event 'MeasureCounterEvent START)
\r
189 measureCounterEnd =
\r
190 #(make-span-event 'MeasureCounterEvent STOP)
\r
195 \grobdescriptions #my-grob-descriptions
\r
200 \consists \measureCounterEngraver
\r
201 \override MeasureCounter #'font-encoding = #'fetaText
\r
202 \override MeasureCounter #'font-size = #-2
\r
205 partCombineListener = \layout {
\r
206 \partCombineListener
\r
209 \grobdescriptions #my-grob-descriptions
\r