1\version "2.19.21" 2 3\header { 4 texidoc = "Use @code{define-event-class}, scheme engraver methods, 5and grob creation methods to create a fully functional text spanner 6in scheme." 7} 8 9#(define-event-class 'scheme-text-span-event 'span-event) 10 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 23 spanner-interface))) 24 (else '(unknown-interface))) 25 ifaces-entry)) 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 30 ifaces-entry)) 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)))) 35 36#(add-grob-definition 37 'SchemeTextSpanner 38 `( 39 (bound-details . ((left . ((Y . 0) 40 (padding . 0.25) 41 (attach-dir . ,LEFT) 42 )) 43 (left-broken . ((end-on-note . #t))) 44 (right . ((Y . 0) 45 (padding . 0.25) 46 )) 47 )) 48 (dash-fraction . 0.2) 49 (dash-period . 3.0) 50 (direction . ,UP) 51 (font-shape . italic) 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) 55 (staff-padding . 0.8) 56 (stencil . ,ly:line-spanner::print) 57 (style . dashed-line) 58 59 (meta . ((class . Spanner) 60 (interfaces . (font-interface 61 line-interface 62 line-spanner-interface 63 outside-staff-interface 64 side-position-interface)))))) 65 66#(define scheme-event-spanner-types 67 '( 68 (SchemeTextSpanEvent 69 . ((description . "Used to signal where scheme text spanner brackets 70start and stop.") 71 (types . (post-event scheme-text-span-event span-event event)) 72 )) 73 )) 74 75#(set! 76 scheme-event-spanner-types 77 (map (lambda (x) 78 (set-object-property! (car x) 79 'music-description 80 (cdr (assq 'description (cdr x)))) 81 (let ((lst (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) 85 (cons (car x) lst))) 86 scheme-event-spanner-types)) 87 88#(set! music-descriptions 89 (append scheme-event-spanner-types music-descriptions)) 90 91#(set! music-descriptions 92 (sort music-descriptions alist<?)) 93 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))) 98 99#(define (axis-offset-symbol axis) 100 (if (eqv? axis X) 'X-offset 'Y-offset)) 101 102#(define (set-axis! grob axis) 103 (if (not (number? (ly:grob-property grob 'side-axis))) 104 (begin 105 (set! (ly:grob-property grob 'side-axis) axis) 106 (ly:grob-chain-callback 107 grob 108 (if (eqv? axis X) 109 ly:side-position-interface::x-aligned-side 110 side-position-interface::y-aligned-side) 111 (axis-offset-symbol axis))))) 112 113schemeTextSpannerEngraver = 114#(lambda (context) 115 (let ((span '()) 116 (finished '()) 117 (event-start '()) 118 (event-stop '())) 119 (make-engraver 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) 126 (begin 127 (ly:pointer-group-interface::add-grob span 'note-columns grob) 128 (add-bound-item span grob))) 129 (if (ly:spanner? finished) 130 (begin 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) 135 (if (null? span) 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) 139 (set! span '()) 140 (set! event-stop '())))) 141 (if (ly:stream-event? event-start) 142 (begin (set! span (ly:engraver-make-grob trans 'SchemeTextSpanner event-start)) 143 (set-axis! span Y) 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) 151 (begin 152 (if (null? (ly:spanner-bound finished RIGHT)) 153 (ly:spanner-set-bound! finished RIGHT 154 (ly:context-property context 'currentMusicalColumn))) 155 (set! finished '()) 156 (set! event-start '()) 157 (set! event-stop '())))) 158 ((finalize trans) 159 (if (ly:spanner? finished) 160 (begin 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) 166 (begin 167 (ly:warning "I think there's a dangling scheme text spanner :-(") 168 (ly:grob-suicide! span) 169 (set! span '()))))))) 170 171schemeTextSpannerStart = 172#(make-span-event 'SchemeTextSpanEvent START) 173 174schemeTextSpannerEnd = 175#(make-span-event 'SchemeTextSpanEvent STOP) 176 177\layout { 178 \context { 179 \Global 180 \grobdescriptions #all-grob-descriptions 181 } 182 \context { 183 \Voice 184 \consists \schemeTextSpannerEngraver 185 } 186} 187 188\relative { 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 | 196} 197