From 26a04c1f923f384d3a36c571bb3ebcdb1aabda9b Mon Sep 17 00:00:00 2001 From: Phil Holmes Date: Sun, 15 Jul 2012 14:10:22 +0100 Subject: [PATCH] Adds support for cross staff stems final --- .../snippets/new/cross-staff-stems.ly | 30 ++++ .../snippets/new/stem-cross-staff-engraver.ly | 168 ------------------ input/regression/cross-staff-stems.ly | 30 ++++ ly/music-functions-init.ly | 13 +- scm/music-functions.scm | 89 ++++++++++ 5 files changed, 161 insertions(+), 169 deletions(-) create mode 100644 Documentation/snippets/new/cross-staff-stems.ly delete mode 100644 Documentation/snippets/new/stem-cross-staff-engraver.ly create mode 100644 input/regression/cross-staff-stems.ly diff --git a/Documentation/snippets/new/cross-staff-stems.ly b/Documentation/snippets/new/cross-staff-stems.ly new file mode 100644 index 0000000000..2168e20222 --- /dev/null +++ b/Documentation/snippets/new/cross-staff-stems.ly @@ -0,0 +1,30 @@ +\version "2.15.42" + +\header { + lsrtags = "staff-notation, tweaks-and-overrides, contexts-and-engravers" + texidoc = "This file demonstrates a scheme engraver that +connects stems across staves. The stem length need not be specified, as +the code takes care of the variable distance between noteheads and staves." + doctitle = "Cross staff stems" +} + +\layout { + \context { + \PianoStaff + \consists #Span_stem_engraver + } +} + +{ + \new PianoStaff << + \new Staff { + 4 r d'16\> e'8. g8 r\! + } + \new Staff { + \clef bass + \voiceOne + \autoBeamOff + \crossStaff { 4 e, g16 a8. c8} d + } + >> +} diff --git a/Documentation/snippets/new/stem-cross-staff-engraver.ly b/Documentation/snippets/new/stem-cross-staff-engraver.ly deleted file mode 100644 index ba21195648..0000000000 --- a/Documentation/snippets/new/stem-cross-staff-engraver.ly +++ /dev/null @@ -1,168 +0,0 @@ -\version "2.15.35" - -\header { - lsrtags = "staff-notation, tweaks-and-overrides, contexts-and-engravers" - texidoc = "This file defines and demonstrates a scheme engraver that -connects stems across staves. The stem length need not be specified, as -the code takes care of the variable distance between noteheads and staves." - doctitle = "Stem cross staff engraver" -} - -%{ - A new stem (referred to as span in the code) is created to connect the - original stems. The original stems are made transparent. - - The span is created as a child of the "root" stem, that is the stem - connected to a notehead with the end that is not to be extended. - - Both stem directions are supported. Connecting more than two stems is - possible. -%} - -% Values are close enough to ignore the difference -#(define (close-enough? x y) - (< (abs (- x y)) 0.0001)) - -% Combine a list of extents -#(define (extent-combine extents) - (if (pair? (cdr extents)) - (interval-union (car extents) (extent-combine (cdr extents))) - (car extents))) - -% Check if the stem is connectable to the root -#(define ((stem-connectable? ref root) stem) - ; The root is always connectable to itself - (or (eq? root stem) - (and - ; Horizontal positions of the stems must be almost the same - (close-enough? (car (ly:grob-extent root ref X)) - (car (ly:grob-extent stem ref X))) - ; The stem must be in the direction away from the root's notehead - (positive? (* (ly:grob-property root 'direction) - (- (car (ly:grob-extent stem ref Y)) - (car (ly:grob-extent root ref Y)))))))) - -% Connect stems if we have at least one stems connectable to the root -#(define (stem-span-stencil span) - (let* ((system (ly:grob-system span)) - (root (ly:grob-parent span X)) - (stems (filter (stem-connectable? system root) - (ly:grob-object span 'stems)))) - (if (<= 2 (length stems)) - (let* ((yextents (map (lambda (st) - (ly:grob-extent st system Y)) stems)) - (yextent (extent-combine yextents)) - (layout (ly:grob-layout root)) - (blot (ly:output-def-lookup layout 'blot-diameter))) - ; Hide spanned stems - (map (lambda (st) - (set! (ly:grob-property st 'transparent) #t)) - stems) - ; Draw a nice looking stem with rounded corners - (ly:round-filled-box (ly:grob-extent root root X) yextent blot)) - ; Nothing to connect, don't draw the span - #f))) - -% Create a stem span as a child of the cross-staff stem (the root) -#(define ((make-stem-span! stems trans) root) - (let ((span (ly:engraver-make-grob trans 'Stem '()))) - (ly:grob-set-parent! span X root) - (set! (ly:grob-object span 'stems) stems) - ; Suppress positioning, the stem code is confused by this weird stem - (set! (ly:grob-property span 'X-offset) 0) - (set! (ly:grob-property span 'stencil) stem-span-stencil))) - -% Set cross-staff property of the stem to this function to connect it to -% other stems automatically -#(define (cross-staff-connect stem) - #t) - -% Check if automatic connecting of the stem was requested. Stems connected -% to cross-staff beams are cross-staff, but they should not be connected to -% other stems just because of that. -#(define (stem-is-root? stem) - (eq? cross-staff-connect (ly:grob-property-data stem 'cross-staff))) - -% Create stem spans for cross-staff stems -#(define (make-stem-spans! ctx stems trans) - ; Cannot do extensive checks here, just make sure there are at least - ; two stems at this musical moment - (if (<= 2 (length stems)) - (let ((roots (filter stem-is-root? stems))) - (map (make-stem-span! stems trans) roots)))) - -% Connect cross-staff stems to the stems above in the system -#(define (Span_stem_engraver ctx) - (let ((stems '())) - (make-engraver - ; Record all stems for the given moment - (acknowledgers - ((stem-interface trans grob source) - (set! stems (cons grob stems)))) - ; Process stems and reset the stem list to empty - ((process-acknowledged trans) - (make-stem-spans! ctx stems trans) - (set! stems '()))))) - -crossStaff = -#(define-music-function (parser location notes) (ly:music?) #{ - \override Stem #'cross-staff = #cross-staff-connect - $notes - \revert Stem #'cross-staff -#}) - -\layout { - \context { - \StaffGroup - \consists #Span_stem_engraver - } -} - -\parallelMusic #'(voiceA voiceB voiceC) { - % Bar 1 - durations, beams, flags - g'2 g'4 g'8 [ g'16 ] g'16 | - \crossStaff { c'2 c'4 c'8 [ c'16 ] c'16 } | - R1 | - - % Bar 2 - direction - g'8 \stemDown g'8 \crossStaff g'8 \stemNeutral g'8 g'4 r4 | - \crossStaff { c'8 \stemDown c'8 } c'8 \stemNeutral c'8 r4 r4 | - c8 \stemDown c8 c8 \stemNeutral \crossStaff { c8 c4 c4 } | - - % Bar 3 - multiple voice styles - << c''2 \\ \crossStaff d'2 \\ a'2 \\ \crossStaff f'2 >> g'2 | - << b'2 \\ c'2 \\ g'2 \\ e'2 >> << e'2 \\ \\ \crossStaff c'2 >> | - << \crossStaff b2 \\ c2 \\ \crossStaff g2 \\ e2 >> r2 | - - % Bar 4 - grace notes - \grace g'8 a'2 \stemDown \crossStaff { \grace g'8 a'2 } \stemNeutral | - \grace c'8 d'2 \stemDown \grace c'8 d'2 \stemNeutral | - \crossStaff { \grace c8 d2 } \stemDown \grace c8 d2 \stemNeutral | - - % Bar 5 - cross-staff beams - g'8 g'8 g'8 g'8 r2 | - s1 | - \crossStaff { c8 [ \change Staff=stafftwo c''8 ] } - \change Staff=staffthree c8 [ \change Staff=stafftwo c''8 ] r2 | -} - -\score { - \new StaffGroup << - \new Staff = "staffone" << - \new Voice { - \autoBeamOff \voiceA - } - >> - \new Staff = "stafftwo" << - \new Voice { - \autoBeamOff \voiceB - } - >> - \new Staff = "staffthree" << - \new Voice { - \autoBeamOff \clef bass \voiceC - } - >> - >> - \layout { } -} diff --git a/input/regression/cross-staff-stems.ly b/input/regression/cross-staff-stems.ly new file mode 100644 index 0000000000..ae046cacbf --- /dev/null +++ b/input/regression/cross-staff-stems.ly @@ -0,0 +1,30 @@ +\version "2.15.42" + +\header { + + texidoc = "Test for cross-staff stems. The test produces a +piano staff with cross-staff connected crochet, semi-quaver, +dotted quaver (beamed with the semi-quaver) and finally a quaver. +All stems should connect, showing correct spacing and +stem length. The lower connected notes should have no flags." } + +\layout { + \context { + \PianoStaff + \consists #Span_stem_engraver + } +} + +{ + \new PianoStaff << + \new Staff { + 4 r d'16\> e'8. g8 r\! + } + \new Staff { + \clef bass + \voiceOne + \autoBeamOff + \crossStaff { 4 e, g16 a8. c8} d + } + >> +} diff --git a/ly/music-functions-init.ly b/ly/music-functions-init.ly index 9f7fcf8f96..54ada96164 100644 --- a/ly/music-functions-init.ly +++ b/ly/music-functions-init.ly @@ -227,7 +227,7 @@ as @code{\\compoundMeter #'((3 2 8))} or shorter (ly:moment-main-denominator mlen)))) #{ \once \override Staff.TimeSignature #'stencil = #(lambda (grob) - (grob-interpret-markup grob (format-compound-time args))) + (grob-interpret-markup grob (format-compound-time args))) \set Timing.timeSignatureFraction = $timesig \set Timing.baseMoment = $beat \set Timing.beatStructure = $beatGrouping @@ -235,11 +235,22 @@ as @code{\\compoundMeter #'((3 2 8))} or shorter \set Timing.measureLength = $mlen #} )) +crossStaff = +#(define-music-function (parser location notes) (ly:music?) + (_i "Create cross-staff stems") + #{ + \override Stem #'cross-staff = #cross-staff-connect + \override Flag #'style = #'no-flag + $notes + \revert Stem #'cross-staff + \revert Flag #'style +#}) cueClef = #(define-music-function (parser location type) (string?) (_i "Set the current cue clef to @var{type}.") (make-cue-clef-set type)) + cueClefUnset = #(define-music-function (parser location) () (_i "Unset the current cue clef.") diff --git a/scm/music-functions.scm b/scm/music-functions.scm index 8c2a326eed..ec264b700a 100644 --- a/scm/music-functions.scm +++ b/scm/music-functions.scm @@ -1767,3 +1767,92 @@ yourself." "Return a list of all pitches from @var{event-chord}." (map (lambda (x) (ly:music-property x 'pitch)) (event-chord-notes event-chord))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; The following functions are all associated with the crossStaff +; function + +(define (close-enough? x y) + "Values are close enough to ignore the difference" + (< (abs (- x y)) 0.0001)) + +(define (extent-combine extents) + "Combine a list of extents" + (if (pair? (cdr extents)) + (interval-union (car extents) (extent-combine (cdr extents))) + (car extents))) + +(define ((stem-connectable? ref root) stem) + "Check if the stem is connectable to the root" + ; The root is always connectable to itself + (or (eq? root stem) + (and + ; Horizontal positions of the stems must be almost the same + (close-enough? (car (ly:grob-extent root ref X)) + (car (ly:grob-extent stem ref X))) + ; The stem must be in the direction away from the root's notehead + (positive? (* (ly:grob-property root 'direction) + (- (car (ly:grob-extent stem ref Y)) + (car (ly:grob-extent root ref Y)))))))) + +(define (stem-span-stencil span) + "Connect stems if we have at least one stem connectable to the root" + (let* ((system (ly:grob-system span)) + (root (ly:grob-parent span X)) + (stems (filter (stem-connectable? system root) + (ly:grob-object span 'stems)))) + (if (<= 2 (length stems)) + (let* ((yextents (map (lambda (st) + (ly:grob-extent st system Y)) stems)) + (yextent (extent-combine yextents)) + (layout (ly:grob-layout root)) + (blot (ly:output-def-lookup layout 'blot-diameter))) + ; Hide spanned stems + (map (lambda (st) + (set! (ly:grob-property st 'transparent) #t)) + stems) + ; Draw a nice looking stem with rounded corners + (ly:round-filled-box (ly:grob-extent root root X) yextent blot)) + ; Nothing to connect, don't draw the span + #f))) + +(define ((make-stem-span! stems trans) root) + "Create a stem span as a child of the cross-staff stem (the root)" + (let ((span (ly:engraver-make-grob trans 'Stem '()))) + (ly:grob-set-parent! span X root) + (set! (ly:grob-object span 'stems) stems) + ; Suppress positioning, the stem code is confused by this weird stem + (set! (ly:grob-property span 'X-offset) 0) + (set! (ly:grob-property span 'stencil) stem-span-stencil))) + +(define-public (cross-staff-connect stem) + "Set cross-staff property of the stem to this function to connect it to +other stems automatically" + #t) + +(define (stem-is-root? stem) + "Check if automatic connecting of the stem was requested. Stems connected +to cross-staff beams are cross-staff, but they should not be connected to +other stems just because of that." + (eq? cross-staff-connect (ly:grob-property-data stem 'cross-staff))) + +(define (make-stem-spans! ctx stems trans) + "Create stem spans for cross-staff stems" + ; Cannot do extensive checks here, just make sure there are at least + ; two stems at this musical moment + (if (<= 2 (length stems)) + (let ((roots (filter stem-is-root? stems))) + (map (make-stem-span! stems trans) roots)))) + +(define-public (Span_stem_engraver ctx) + "Connect cross-staff stems to the stems above in the system" + (let ((stems '())) + (make-engraver + ; Record all stems for the given moment + (acknowledgers + ((stem-interface trans grob source) + (set! stems (cons grob stems)))) + ; Process stems and reset the stem list to empty + ((process-acknowledged trans) + (make-stem-spans! ctx stems trans) + (set! stems '()))))) -- 2.39.5