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 'span-event)
11 #(define (add-grob-definition grob-name grob-entry)
12 (let* ((meta-entry (assoc-get 'meta grob-entry))
13 (class (assoc-get 'class meta-entry))
14 (ifaces-entry (assoc-get 'interfaces meta-entry)))
15 (set-object-property! grob-name 'translation-type? ly:grob-properties?)
16 (set-object-property! grob-name 'is-grob? #t)
17 (set! ifaces-entry (append (case class
18 ((Item) '(item-interface))
19 ((Spanner) '(spanner-interface))
20 ((Paper_column) '((item-interface
21 paper-column-interface)))
22 ((System) '((system-interface
24 (else '(unknown-interface)))
26 (set! ifaces-entry (uniq-list (sort ifaces-entry symbol<?)))
27 (set! ifaces-entry (cons 'grob-interface ifaces-entry))
28 (set! meta-entry (assoc-set! meta-entry 'name grob-name))
29 (set! meta-entry (assoc-set! meta-entry 'interfaces
31 (set! grob-entry (assoc-set! grob-entry 'meta meta-entry))
32 (set! all-grob-descriptions
33 (cons (cons grob-name grob-entry)
34 all-grob-descriptions))))
39 (bound-details . ((left . ((Y . 0)
43 (left-broken . ((end-on-note . #t)))
52 (left-bound-info . ,ly:line-spanner::calc-left-bound-info)
53 (outside-staff-priority . 350)
54 (right-bound-info . ,ly:line-spanner::calc-right-bound-info)
56 (stencil . ,ly:line-spanner::print)
59 (meta . ((class . Spanner)
60 (interfaces . (font-interface
62 line-spanner-interface
63 outside-staff-interface
64 side-position-interface))))))
66 #(define scheme-event-spanner-types
69 . ((description . "Used to signal where scheme text spanner brackets
71 (types . (post-event scheme-text-span-event span-event event))
76 scheme-event-spanner-types
78 (set-object-property! (car x)
80 (cdr (assq 'description (cdr x))))
82 (set! lst (assoc-set! lst 'name (car x)))
83 (set! lst (assq-remove! lst 'description))
84 (hashq-set! music-name-to-property-table (car x) lst)
86 scheme-event-spanner-types))
88 #(set! music-descriptions
89 (append scheme-event-spanner-types music-descriptions))
91 #(set! music-descriptions
92 (sort music-descriptions alist<?))
94 #(define (add-bound-item spanner item)
95 (if (null? (ly:spanner-bound spanner LEFT))
96 (ly:spanner-set-bound! spanner LEFT item)
97 (ly:spanner-set-bound! spanner RIGHT item)))
99 #(define (axis-offset-symbol axis)
100 (if (eq? axis X) 'X-offset 'Y-offset))
102 #(define (set-axis! grob axis)
103 (if (not (number? (ly:grob-property grob 'side-axis)))
105 (set! (ly:grob-property grob 'side-axis) axis)
106 (ly:grob-chain-callback
109 ly:side-position-interface::x-aligned-side
110 side-position-interface::y-aligned-side)
111 (axis-offset-symbol axis)))))
113 schemeTextSpannerEngraver =
120 (listeners ((scheme-text-span-event engraver event)
121 (if (= START (ly:event-property event 'span-direction))
122 (set! event-start event)
123 (set! event-stop event))))
124 (acknowledgers ((note-column-interface engraver grob source-engraver)
125 (if (ly:spanner? span)
127 (ly:pointer-group-interface::add-grob span 'note-columns grob)
128 (add-bound-item span grob)))
129 (if (ly:spanner? finished)
131 (ly:pointer-group-interface::add-grob finished 'note-columns grob)
132 (add-bound-item finished grob)))))
133 ((process-music trans)
134 (if (ly:stream-event? event-stop)
136 (ly:warning "You're trying to end a scheme text spanner but you haven't started one.")
137 (begin (set! finished span)
138 (ly:engraver-announce-end-grob trans finished event-start)
140 (set! event-stop '()))))
141 (if (ly:stream-event? event-start)
142 (begin (set! span (ly:engraver-make-grob trans 'SchemeTextSpanner event-start))
144 (set! event-start '()))))
145 ((stop-translation-timestep trans)
146 (if (and (ly:spanner? span)
147 (null? (ly:spanner-bound span LEFT)))
148 (ly:spanner-set-bound! span LEFT
149 (ly:context-property context 'currentMusicalColumn)))
150 (if (ly:spanner? finished)
152 (if (null? (ly:spanner-bound finished RIGHT))
153 (ly:spanner-set-bound! finished RIGHT
154 (ly:context-property context 'currentMusicalColumn)))
156 (set! event-start '())
157 (set! event-stop '()))))
159 (if (ly:spanner? finished)
161 (if (null? (ly:spanner-bound finished RIGHT))
162 (ly:spanner-set-bound! finished RIGHT
163 (ly:context-property context 'currentMusicalColumn)))
164 (set! finished '())))
165 (if (ly:spanner? span)
167 (ly:warning "I think there's a dangling scheme text spanner :-(")
168 (ly:grob-suicide! span)
169 (set! span '())))))))
171 schemeTextSpannerStart =
172 #(make-span-event 'SchemeTextSpanEvent START)
174 schemeTextSpannerEnd =
175 #(make-span-event 'SchemeTextSpanEvent STOP)
180 \grobdescriptions #all-grob-descriptions
184 \consists \schemeTextSpannerEngraver
189 a4 b\schemeTextSpannerStart c d |
190 \repeat unfold 20 { a4 b c d | }
191 a4 b c\schemeTextSpannerEnd d |
192 \override SchemeTextSpanner.to-barline = ##t
193 a4\schemeTextSpannerStart b d c |
194 \repeat unfold 20 { a4 b c d | }
195 a1\schemeTextSpannerEnd |