4 lsrtags = "staff-notation, tweaks-and-overrides, contexts-and-engravers"
5 texidoc = "This file defines and demonstrates a scheme engraver that
6 connects stems across staves. The stem length need not be specified, as
7 the code takes care of the variable distance between noteheads and staves."
8 doctitle = "Stem cross staff engraver"
12 A new stem (referred to as span in the code) is created to connect the
13 original stems. The original stems are made transparent.
15 The span is created as a child of the "root" stem, that is the stem
16 connected to a notehead with the end that is not to be extended.
18 Both stem directions are supported. Connecting more than two stems is
22 % Values are close enough to ignore the difference
23 #(define (close-enough? x y)
24 (< (abs (- x y)) 0.0001))
26 % Combine a list of extents
27 #(define (extent-combine extents)
28 (if (pair? (cdr extents))
29 (interval-union (car extents) (extent-combine (cdr extents)))
32 % Check if the stem is connectable to the root
33 #(define ((stem-connectable? ref root) stem)
34 ; The root is always connectable to itself
37 ; Horizontal positions of the stems must be almost the same
38 (close-enough? (car (ly:grob-extent root ref X))
39 (car (ly:grob-extent stem ref X)))
40 ; The stem must be in the direction away from the root's notehead
41 (positive? (* (ly:grob-property root 'direction)
42 (- (car (ly:grob-extent stem ref Y))
43 (car (ly:grob-extent root ref Y))))))))
45 % Connect stems if we have at least one stems connectable to the root
46 #(define (stem-span-stencil span)
47 (let* ((system (ly:grob-system span))
48 (root (ly:grob-parent span X))
49 (stems (filter (stem-connectable? system root)
50 (ly:grob-object span 'stems))))
51 (if (<= 2 (length stems))
52 (let* ((yextents (map (lambda (st)
53 (ly:grob-extent st system Y)) stems))
54 (yextent (extent-combine yextents))
55 (layout (ly:grob-layout root))
56 (blot (ly:output-def-lookup layout 'blot-diameter)))
59 (set! (ly:grob-property st 'transparent) #t))
61 ; Draw a nice looking stem with rounded corners
62 (ly:round-filled-box (ly:grob-extent root root X) yextent blot))
63 ; Nothing to connect, don't draw the span
66 % Create a stem span as a child of the cross-staff stem (the root)
67 #(define ((make-stem-span! stems trans) root)
68 (let ((span (ly:engraver-make-grob trans 'Stem '())))
69 (ly:grob-set-parent! span X root)
70 (set! (ly:grob-object span 'stems) stems)
71 ; Suppress positioning, the stem code is confused by this weird stem
72 (set! (ly:grob-property span 'X-offset) 0)
73 (set! (ly:grob-property span 'stencil) stem-span-stencil)))
75 % Set cross-staff property of the stem to this function to connect it to
76 % other stems automatically
77 #(define (cross-staff-connect stem)
80 % Check if automatic connecting of the stem was requested. Stems connected
81 % to cross-staff beams are cross-staff, but they should not be connected to
82 % other stems just because of that.
83 #(define (stem-is-root? stem)
84 (eq? cross-staff-connect (ly:grob-property-data stem 'cross-staff)))
86 % Create stem spans for cross-staff stems
87 #(define (make-stem-spans! ctx stems trans)
88 ; Cannot do extensive checks here, just make sure there are at least
89 ; two stems at this musical moment
90 (if (<= 2 (length stems))
91 (let ((roots (filter stem-is-root? stems)))
92 (map (make-stem-span! stems trans) roots))))
94 % Connect cross-staff stems to the stems above in the system
95 #(define (Span_stem_engraver ctx)
98 ; Record all stems for the given moment
100 ((stem-interface trans grob source)
101 (set! stems (cons grob stems))))
102 ; Process stems and reset the stem list to empty
103 ((process-acknowledged trans)
104 (make-stem-spans! ctx stems trans)
108 #(define-music-function (parser location notes) (ly:music?) #{
109 \override Stem #'cross-staff = #cross-staff-connect
111 \revert Stem #'cross-staff
117 \consists #Span_stem_engraver
121 \parallelMusic #'(voiceA voiceB voiceC) {
122 % Bar 1 - durations, beams, flags
123 g'2 g'4 g'8 [ g'16 ] g'16 |
124 \crossStaff { c'2 c'4 c'8 [ c'16 ] c'16 } |
128 g'8 \stemDown g'8 \crossStaff g'8 \stemNeutral g'8 g'4 r4 |
129 \crossStaff { c'8 \stemDown c'8 } c'8 \stemNeutral c'8 r4 r4 |
130 c8 \stemDown c8 c8 \stemNeutral \crossStaff { c8 c4 c4 } |
132 % Bar 3 - multiple voice styles
133 << c''2 \\ \crossStaff d'2 \\ a'2 \\ \crossStaff f'2 >> g'2 |
134 << b'2 \\ c'2 \\ g'2 \\ e'2 >> << e'2 \\ \\ \crossStaff c'2 >> |
135 << \crossStaff b2 \\ c2 \\ \crossStaff g2 \\ e2 >> r2 |
137 % Bar 4 - grace notes
138 \grace g'8 a'2 \stemDown \crossStaff { \grace g'8 a'2 } \stemNeutral |
139 \grace c'8 d'2 \stemDown \grace c'8 d'2 \stemNeutral |
140 \crossStaff { \grace c8 d2 } \stemDown \grace c8 d2 \stemNeutral |
142 % Bar 5 - cross-staff beams
145 \crossStaff { c8 [ \change Staff=stafftwo c''8 ] }
146 \change Staff=staffthree c8 [ \change Staff=stafftwo c''8 ] r2 |
151 \new Staff = "staffone" <<
156 \new Staff = "stafftwo" <<
161 \new Staff = "staffthree" <<
163 \autoBeamOff \clef bass \voiceC