4 texidoc = "Use @code{define-event-class}, scheme engraver methods,
5 and grob creation methods to create a fully functional text spanner
9 #(define-event-class 'scheme-text-span-event
10 '(scheme-text-span-event
15 #(define (add-grob-definition grob-name grob-entry)
16 (let* ((meta-entry (assoc-get 'meta grob-entry))
17 (class (assoc-get 'class meta-entry))
18 (ifaces-entry (assoc-get 'interfaces meta-entry)))
19 (set-object-property! grob-name 'translation-type? list?)
20 (set-object-property! grob-name 'is-grob? #t)
21 (set! ifaces-entry (append (case class
22 ((Item) '(item-interface))
23 ((Spanner) '(spanner-interface))
24 ((Paper_column) '((item-interface
25 paper-column-interface)))
26 ((System) '((system-interface
28 (else '(unknown-interface)))
30 (set! ifaces-entry (uniq-list (sort ifaces-entry symbol<?)))
31 (set! ifaces-entry (cons 'grob-interface ifaces-entry))
32 (set! meta-entry (assoc-set! meta-entry 'name grob-name))
33 (set! meta-entry (assoc-set! meta-entry 'interfaces
35 (set! grob-entry (assoc-set! grob-entry 'meta meta-entry))
36 (set! all-grob-descriptions
37 (cons (cons grob-name grob-entry)
38 all-grob-descriptions))))
43 (bound-details . ((left . ((Y . 0)
47 (left-broken . ((end-on-note . #t)))
56 (left-bound-info . ,ly:line-spanner::calc-left-bound-info)
57 (outside-staff-priority . 350)
58 (right-bound-info . ,ly:line-spanner::calc-right-bound-info)
60 (stencil . ,ly:line-spanner::print)
63 (meta . ((class . Spanner)
64 (interfaces . (font-interface
66 line-spanner-interface
67 side-position-interface))))))
69 #(define scheme-event-spanner-types
72 . ((description . "Used to signal where scheme text spanner brackets
74 (types . (general-music scheme-text-span-event span-event event))
79 scheme-event-spanner-types
81 (set-object-property! (car x)
83 (cdr (assq 'description (cdr x))))
85 (set! lst (assoc-set! lst 'name (car x)))
86 (set! lst (assq-remove! lst 'description))
87 (hashq-set! music-name-to-property-table (car x) lst)
89 scheme-event-spanner-types))
91 #(set! music-descriptions
92 (append scheme-event-spanner-types music-descriptions))
94 #(set! music-descriptions
95 (sort music-descriptions alist<?))
97 #(define (add-bound-item spanner item)
98 (if (null? (ly:spanner-bound spanner LEFT))
99 (ly:spanner-set-bound! spanner LEFT item)
100 (ly:spanner-set-bound! spanner RIGHT item)))
102 #(define (axis-offset-symbol axis)
103 (if (eq? axis X) 'X-offset 'Y-offset))
105 #(define (set-axis! grob axis)
106 (if (not (number? (ly:grob-property grob 'side-axis)))
108 (set! (ly:grob-property grob 'side-axis) axis)
109 (ly:grob-chain-callback
112 ly:side-position-interface::x-aligned-side
113 ly:side-position-interface::y-aligned-side)
114 (axis-offset-symbol axis)))))
116 schemeTextSpannerEngraver =
121 (event-drul '(() . ())))
122 (list (cons 'listeners
123 (list (cons 'scheme-text-span-event
124 (lambda (engraver event)
125 (if (= START (ly:event-property event 'span-direction))
126 (set-car! event-drul event)
127 (set-cdr! event-drul event))))))
129 (list (cons 'note-column-interface
130 (lambda (engraver grob source-engraver)
131 (if (ly:spanner? span)
133 (ly:pointer-group-interface::add-grob span 'note-columns grob)
134 (add-bound-item span grob)))
135 (if (ly:spanner? finished)
137 (ly:pointer-group-interface::add-grob finished 'note-columns grob)
138 (add-bound-item finished grob)))))))
141 (if (ly:stream-event? (cdr event-drul))
143 (ly:warning "You're trying to end a scheme text spanner but you haven't started one.")
144 (begin (set! finished span)
145 (ly:engraver-announce-end-grob trans finished current-event)
147 (set! current-event '())
148 (set-cdr! event-drul '()))))
149 (if (ly:stream-event? (car event-drul))
150 (begin (set! current-event (car event-drul))
151 (set! span (ly:engraver-make-grob trans 'SchemeTextSpanner current-event))
153 (set-car! event-drul '())))))
154 (cons 'stop-translation-timestep
156 (if (and (ly:spanner? span)
157 (null? (ly:spanner-bound span LEFT)))
158 (set! (ly:spanner-bound span LEFT)
159 (ly:context-property context 'currentMusicalColumn)))
160 (if (ly:spanner? finished)
162 (if (null? (ly:spanner-bound finished RIGHT))
163 (set! (ly:spanner-bound finished RIGHT)
164 (ly:context-property context 'currentMusicalColumn)))
166 (set! event-drul '(() . ()))))))
169 (if (ly:spanner? finished)
171 (if (null? (ly:spanner-bound finished RIGHT))
172 (set! (ly:spanner-bound finished RIGHT)
173 (ly:context-property context 'currentMusicalColumn)))
174 (set! finished '())))
175 (if (ly:spanner? span)
177 (ly:warning "I think there's a dangling scheme text spanner :-(")
178 (ly:grob-suicide! span)
179 (set! span '()))))))))
181 schemeTextSpannerStart =
182 #(make-span-event 'SchemeTextSpanEvent START)
184 schemeTextSpannerEnd =
185 #(make-span-event 'SchemeTextSpanEvent STOP)
190 \grobdescriptions #all-grob-descriptions
194 \consists \schemeTextSpannerEngraver
199 a4 b\schemeTextSpannerStart c d |
200 \repeat unfold 20 { a4 b c d | }
201 a4 b c\schemeTextSpannerEnd d |
202 \override SchemeTextSpanner #'to-barline = ##t
203 a4\schemeTextSpannerStart b d c |
204 \repeat unfold 20 { a4 b c d | }
205 a1\schemeTextSpannerEnd |