Documentation/snippets/stem-cross-staff-engraver.ly

   1 % DO NOT EDIT this file manually; it is automatically
   2 % generated from Documentation/snippets/new
   3 % Make any changes in Documentation/snippets/new/
   4 % and then run scripts/auxiliar/makelsr.py
   5 %
   6 % This file is in the public domain.
   7 %% Note: this file works from version 2.15.35
   8 \version "2.15.35"
   9
  10 \header {
  11 %% Translation of GIT committish: 28097cf54698db364afeb75658e4c8e0e0ccd716
  12   texidocfr = "
  13 Le code ci-dessous illustre la manière de concevoir un graveur en
  14 Scheme, ici chargé de connecter des hampes entre les portées.  Nul n'est
  15 besoin de spécifier la taille des hampes ; la fonction tient compte de
  16 la distance relative des têtes de note avec les portées.
  17
  18 "
  19   doctitlefr = "Graveur de hampes inter-portées"
  20
  21   lsrtags = "staff-notation, tweaks-and-overrides, contexts-and-engravers"
  22   texidoc = "This file defines and demonstrates a scheme engraver that
  23 connects stems across staves.  The stem length need not be specified, as
  24 the code takes care of the variable distance between noteheads and staves."
  25   doctitle = "Stem cross staff engraver"
  26 } % begin verbatim
  27
  28
  29 %{
  30   A new stem (referred to as span in the code) is created to connect the
  31   original stems.  The original stems are made transparent.
  32
  33   The span is created as a child of the "root" stem, that is the stem
  34   connected to a notehead with the end that is not to be extended.
  35
  36   Both stem directions are supported.  Connecting more than two stems is
  37   possible.
  38 %}
  39
  40 % Values are close enough to ignore the difference
  41 #(define (close-enough? x y)
  42    (< (abs (- x y)) 0.0001))
  43
  44 % Combine a list of extents
  45 #(define (extent-combine extents)
  46    (if (pair? (cdr extents))
  47        (interval-union (car extents) (extent-combine (cdr extents)))
  48        (car extents)))
  49
  50 % Check if the stem is connectable to the root
  51 #(define ((stem-connectable? ref root) stem)
  52    ; The root is always connectable to itself
  53    (or (eq? root stem)
  54        (and
  55         ; Horizontal positions of the stems must be almost the same
  56         (close-enough? (car (ly:grob-extent root ref X))
  57           (car (ly:grob-extent stem ref X)))
  58         ; The stem must be in the direction away from the root's notehead
  59         (positive? (* (ly:grob-property root 'direction)
  60                      (- (car (ly:grob-extent stem ref Y))
  61                        (car (ly:grob-extent root ref Y))))))))
  62
  63 % Connect stems if we have at least one stems connectable to the root
  64 #(define (stem-span-stencil span)
  65    (let* ((system (ly:grob-system span))
  66           (root (ly:grob-parent span X))
  67           (stems (filter (stem-connectable? system root)
  68                          (ly:grob-object span 'stems))))
  69      (if (<= 2 (length stems))
  70          (let* ((yextents (map (lambda (st)
  71                                  (ly:grob-extent st system Y)) stems))
  72                 (yextent (extent-combine yextents))
  73                 (layout (ly:grob-layout root))
  74                 (blot (ly:output-def-lookup layout 'blot-diameter)))
  75            ; Hide spanned stems
  76            (map (lambda (st)
  77                   (set! (ly:grob-property st 'transparent) #t))
  78              stems)
  79            ; Draw a nice looking stem with rounded corners
  80            (ly:round-filled-box (ly:grob-extent root root X) yextent blot))
  81          ; Nothing to connect, don't draw the span
  82          #f)))
  83
  84 % Create a stem span as a child of the cross-staff stem (the root)
  85 #(define ((make-stem-span! stems trans) root)
  86    (let ((span (ly:engraver-make-grob trans 'Stem '())))
  87      (ly:grob-set-parent! span X root)
  88      (set! (ly:grob-object span 'stems) stems)
  89      ; Suppress positioning, the stem code is confused by this weird stem
  90      (set! (ly:grob-property span 'X-offset) 0)
  91      (set! (ly:grob-property span 'stencil) stem-span-stencil)))
  92
  93 % Set cross-staff property of the stem to this function to connect it to
  94 % other stems automatically
  95 #(define (cross-staff-connect stem)
  96    #t)
  97
  98 % Check if automatic connecting of the stem was requested.  Stems connected
  99 % to cross-staff beams are cross-staff, but they should not be connected to
 100 % other stems just because of that.
 101 #(define (stem-is-root? stem)
 102    (eq? cross-staff-connect (ly:grob-property-data stem 'cross-staff)))
 103
 104 % Create stem spans for cross-staff stems
 105 #(define (make-stem-spans! ctx stems trans)
 106    ; Cannot do extensive checks here, just make sure there are at least
 107    ; two stems at this musical moment
 108    (if (<= 2 (length stems))
 109        (let ((roots (filter stem-is-root? stems)))
 110          (map (make-stem-span! stems trans) roots))))
 111
 112 % Connect cross-staff stems to the stems above in the system
 113 #(define (Span_stem_engraver ctx)
 114    (let ((stems '()))
 115      (make-engraver
 116       ; Record all stems for the given moment
 117       (acknowledgers
 118        ((stem-interface trans grob source)
 119         (set! stems (cons grob stems))))
 120       ; Process stems and reset the stem list to empty
 121       ((process-acknowledged trans)
 122        (make-stem-spans! ctx stems trans)
 123        (set! stems '())))))
 124
 125 crossStaff =
 126 #(define-music-function (parser location notes) (ly:music?) #{
 127   \override Stem #'cross-staff = #cross-staff-connect
 128   $notes
 129   \revert Stem #'cross-staff
 130 #})
 131
 132 \layout {
 133   \context {
 134     \StaffGroup
 135     \consists #Span_stem_engraver
 136   }
 137 }
 138
 139 \parallelMusic #'(voiceA voiceB voiceC) {
 140   % Bar 1 - durations, beams, flags
 141   g'2 g'4 g'8 [ g'16 ] g'16 |
 142   \crossStaff { c'2 c'4 c'8 [ c'16 ] c'16 } |
 143   R1 |
 144
 145   % Bar 2 - direction
 146   g'8 \stemDown g'8 \crossStaff g'8 \stemNeutral g'8 g'4 r4 |
 147   \crossStaff { c'8 \stemDown c'8 } c'8 \stemNeutral c'8 r4 r4 |
 148   c8 \stemDown c8 c8 \stemNeutral \crossStaff { c8 c4 c4 } |
 149
 150   % Bar 3 - multiple voice styles
 151   << c''2 \\ \crossStaff d'2 \\ a'2 \\ \crossStaff f'2 >> g'2 |
 152   << b'2 \\ c'2 \\ g'2 \\ e'2 >> << e'2 \\ \\ \crossStaff c'2 >> |
 153   << \crossStaff b2 \\ c2 \\ \crossStaff g2 \\ e2 >> r2 |
 154
 155   % Bar 4 - grace notes
 156   \grace g'8 a'2 \stemDown \crossStaff { \grace g'8 a'2 } \stemNeutral |
 157   \grace c'8 d'2 \stemDown \grace c'8 d'2 \stemNeutral |
 158   \crossStaff { \grace c8 d2 } \stemDown \grace c8 d2 \stemNeutral |
 159
 160   % Bar 5 - cross-staff beams
 161   g'8 g'8 g'8 g'8 r2 |
 162   s1 |
 163   \crossStaff { c8 [ \change Staff=stafftwo c''8 ] }
 164     \change Staff=staffthree c8 [ \change Staff=stafftwo c''8 ] r2 |
 165 }
 166
 167 \score {
 168   \new StaffGroup <<
 169     \new Staff = "staffone" <<
 170       \new Voice {
 171         \autoBeamOff \voiceA
 172       }
 173     >>
 174     \new Staff = "stafftwo" <<
 175       \new Voice {
 176         \autoBeamOff \voiceB
 177       }
 178     >>
 179     \new Staff = "staffthree" <<
 180       \new Voice {
 181         \autoBeamOff \clef bass \voiceC
 182       }
 183     >>
 184   >>
 185   \layout { }
 186 }