4 texidoc = "Use @code{define-event-class}, scheme engraver methods,
5 and grob creation methods to create a fully functional text spanner
9 #(define my-grob-descriptions '())
11 #(define my-event-classes (ly:make-context-mod))
14 #(define-void-function (parser location class parent)
19 ,(lambda (context class parent)
20 (ly:context-set-property!
26 (ly:context-property context 'EventClasses '()))))
29 \defineEventClass #'scheme-text-span-event #'span-event
31 #(define (add-grob-definition grob-name grob-entry)
32 (let* ((meta-entry (assoc-get 'meta grob-entry))
33 (class (assoc-get 'class meta-entry))
34 (ifaces-entry (assoc-get 'interfaces meta-entry)))
35 (set-object-property! grob-name 'translation-type? list?)
36 (set-object-property! grob-name 'is-grob? #t)
37 (set! ifaces-entry (append (case class
38 ((Item) '(item-interface))
39 ((Spanner) '(spanner-interface))
40 ((Paper_column) '((item-interface
41 paper-column-interface)))
42 ((System) '((system-interface
44 (else '(unknown-interface)))
46 (set! ifaces-entry (uniq-list (sort ifaces-entry symbol<?)))
47 (set! ifaces-entry (cons 'grob-interface ifaces-entry))
48 (set! meta-entry (assoc-set! meta-entry 'name grob-name))
49 (set! meta-entry (assoc-set! meta-entry 'interfaces
51 (set! grob-entry (assoc-set! grob-entry 'meta meta-entry))
52 (set! my-grob-descriptions
53 (cons (cons grob-name grob-entry)
54 my-grob-descriptions))))
59 (bound-details . ((left . ((Y . 0)
63 (left-broken . ((end-on-note . #t)))
72 (left-bound-info . ,ly:line-spanner::calc-left-bound-info)
73 (outside-staff-priority . 350)
74 (right-bound-info . ,ly:line-spanner::calc-right-bound-info)
76 (stencil . ,ly:line-spanner::print)
79 (meta . ((class . Spanner)
80 (interfaces . (font-interface
82 line-spanner-interface
83 side-position-interface))))))
85 #(define scheme-event-spanner-types
88 . ((description . "Used to signal where scheme text spanner brackets
90 (types . (general-music scheme-text-span-event span-event event))
95 scheme-event-spanner-types
97 (set-object-property! (car x)
99 (cdr (assq 'description (cdr x))))
101 (set! lst (assoc-set! lst 'name (car x)))
102 (set! lst (assq-remove! lst 'description))
103 (hashq-set! music-name-to-property-table (car x) lst)
105 scheme-event-spanner-types))
107 #(set! music-descriptions
108 (append scheme-event-spanner-types music-descriptions))
110 #(set! music-descriptions
111 (sort music-descriptions alist<?))
113 #(define (add-bound-item spanner item)
114 (if (null? (ly:spanner-bound spanner LEFT))
115 (ly:spanner-set-bound! spanner LEFT item)
116 (ly:spanner-set-bound! spanner RIGHT item)))
118 #(define (axis-offset-symbol axis)
119 (if (eq? axis X) 'X-offset 'Y-offset))
121 #(define (set-axis! grob axis)
122 (if (not (number? (ly:grob-property grob 'side-axis)))
124 (set! (ly:grob-property grob 'side-axis) axis)
125 (ly:grob-chain-callback
128 ly:side-position-interface::x-aligned-side
129 ly:side-position-interface::y-aligned-side)
130 (axis-offset-symbol axis)))))
132 schemeTextSpannerEngraver =
137 (event-drul '(() . ())))
139 (listeners ((scheme-text-span-event engraver event)
140 (if (= START (ly:event-property event 'span-direction))
141 (set-car! event-drul event)
142 (set-cdr! event-drul event))))
143 (acknowledgers ((note-column-interface engraver grob source-engraver)
144 (if (ly:spanner? span)
146 (ly:pointer-group-interface::add-grob span 'note-columns grob)
147 (add-bound-item span grob)))
148 (if (ly:spanner? finished)
150 (ly:pointer-group-interface::add-grob finished 'note-columns grob)
151 (add-bound-item finished grob)))))
152 ((process-music trans)
153 (if (ly:stream-event? (cdr event-drul))
155 (ly:warning "You're trying to end a scheme text spanner but you haven't started one.")
156 (begin (set! finished span)
157 (ly:engraver-announce-end-grob trans finished current-event)
159 (set! current-event '())
160 (set-cdr! event-drul '()))))
161 (if (ly:stream-event? (car event-drul))
162 (begin (set! current-event (car event-drul))
163 (set! span (ly:engraver-make-grob trans 'SchemeTextSpanner current-event))
165 (set-car! event-drul '()))))
166 ((stop-translation-timestep trans)
167 (if (and (ly:spanner? span)
168 (null? (ly:spanner-bound span LEFT)))
169 (set! (ly:spanner-bound span LEFT)
170 (ly:context-property context 'currentMusicalColumn)))
171 (if (ly:spanner? finished)
173 (if (null? (ly:spanner-bound finished RIGHT))
174 (set! (ly:spanner-bound finished RIGHT)
175 (ly:context-property context 'currentMusicalColumn)))
177 (set! event-drul '(() . ())))))
179 (if (ly:spanner? finished)
181 (if (null? (ly:spanner-bound finished RIGHT))
182 (set! (ly:spanner-bound finished RIGHT)
183 (ly:context-property context 'currentMusicalColumn)))
184 (set! finished '())))
185 (if (ly:spanner? span)
187 (ly:warning "I think there's a dangling scheme text spanner :-(")
188 (ly:grob-suicide! span)
189 (set! span '())))))))
191 schemeTextSpannerStart =
192 #(make-span-event 'SchemeTextSpanEvent START)
194 schemeTextSpannerEnd =
195 #(make-span-event 'SchemeTextSpanEvent STOP)
200 \grobdescriptions #my-grob-descriptions
205 \consists \schemeTextSpannerEngraver
210 a4 b\schemeTextSpannerStart c d |
211 \repeat unfold 20 { a4 b c d | }
212 a4 b c\schemeTextSpannerEnd d |
213 \override SchemeTextSpanner #'to-barline = ##t
214 a4\schemeTextSpannerStart b d c |
215 \repeat unfold 20 { a4 b c d | }
216 a1\schemeTextSpannerEnd |