Fix beaming in Kievan notation

Issue 2492

diff --git a/lily/beam.cc b/lily/beam.cc
index 32bf7c3bd468618c13668fa2014dcd72d355d0f6..814d5def3cef4be9869b7af6894fffcd8fef4e97 100644 (file)
--- a/lily/beam.cc
+++ b/lily/beam.cc
@@ -284,6 +284,18 @@ Beam::calc_direction (SCM smob)
             dir = to_dir (stem->get_property_data ("direction"));
           else
             dir = to_dir (stem->get_property ("default-direction"));
+
+          extract_grob_set (stem, "note-heads", heads);
+          /* default position of Kievan heads with beams is down
+             placing this here avoids warnings downstream */
+          if (heads.size())
+            {
+               if (heads[0]->get_property ("style") == ly_symbol2scm ("kievan"))
+                 {
+                    if (dir == CENTER)
+                      dir = DOWN;
+                 }
+            }
         }
     }
 

diff --git a/scm/define-grobs.scm b/scm/define-grobs.scm
index cc83a365a8415c57619f8c3c6686dc2fc1272f72..b66bca7550d81ca5aee384e3c9ed9f66a6ec7a10 100644 (file)
--- a/scm/define-grobs.scm
+++ b/scm/define-grobs.scm
@@ -393,12 +393,12 @@
        (beam-gap . ,ly:beam::calc-beam-gap)
        (minimum-length . ,ly:beam::calc-minimum-length)
        (neutral-direction . ,DOWN)
-       (positions . ,beam::place-broken-parts-individually)
+       (positions . ,beam::get-positions)
        (springs-and-rods . ,ly:beam::calc-springs-and-rods)
        (X-positions . ,ly:beam::calc-x-positions)
 
        ;; this is a hack to set stem lengths, if positions is set.
-       (quantized-positions . ,ly:beam::set-stem-lengths)
+       (quantized-positions . ,beam::get-quantized-positions)
 
        (shorten . ,ly:beam::calc-stem-shorten)
        (vertical-skylines . ,ly:grob::vertical-skylines-from-stencil)

diff --git a/scm/output-lib.scm b/scm/output-lib.scm
index 3ced3354cd2cfba56e2721d655408066a58222ed..8f81340e6d68219b092797bbd9c3b9d423831fc2 100644 (file)
--- a/scm/output-lib.scm
+++ b/scm/output-lib.scm
@@ -61,6 +61,93 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; beam slope
 
+;; sets position of beams for Kievan notation
+(define-public (beam::get-positions grob)
+    (let* ((stems (ly:grob-object grob 'stems))
+           (stems-grobs (if (not (null? stems))
+                            (ly:grob-array->list stems)
+                            '()))
+           (first-stem (if (not (null? stems-grobs))
+                          (car stems-grobs)
+                          '()))
+           (note-heads (if (not (null? first-stem))
+                          (ly:grob-object first-stem 'note-heads)
+                          '()))
+           (note-heads-grobs (if (not (null? note-heads))
+                                (ly:grob-array->list note-heads)
+                                '()))
+           (first-note-head (if (not (null? note-heads-grobs))
+                               (car note-heads-grobs)
+                               '()))
+           (style (if (not (null? first-note-head))
+                     (ly:grob-property first-note-head 'style)
+                     '())))
+          (if (and (symbol? style) (string-match "kievan*" (symbol->string style)))
+              (let* ((next-stem (cadr stems-grobs))
+                     (next-note-heads (if (not (null? next-stem))
+                                         (ly:grob-object next-stem 'note-heads)
+                                         '()))
+                     (next-note-heads-grobs (if (not (null? next-note-heads))
+                                               (ly:grob-array->list next-note-heads)
+                                               '()))
+                     (next-note-head (if (not (null? next-note-heads-grobs))
+                                        (car next-note-heads-grobs)
+                                        '()))
+                     (left-pos (ly:grob-property first-note-head 'Y-offset))
+                     (right-pos (ly:grob-property next-note-head 'Y-offset))
+                     (direction (ly:grob-property grob 'direction))
+                     (left-height (if (= direction DOWN)
+                                     (+ (car (ly:grob::stencil-height first-note-head)) 0.75)
+                                      (- (cdr (ly:grob::stencil-height first-note-head)) 0.75)))
+                     (right-height (if (= direction DOWN)
+                                      (+ (car (ly:grob::stencil-height next-note-head)) 0.75)
+                                       (- (cdr (ly:grob::stencil-height next-note-head)) 0.75))))
+                    (cons (+ left-pos left-height) (+ right-pos right-height)))
+              (beam::place-broken-parts-individually grob))))
+
+(define-public (beam::get-quantized-positions grob)
+    (let* ((stems (ly:grob-object grob 'stems))
+           (stems-grobs (if (not (null? stems))
+                            (ly:grob-array->list stems)
+                            '()))
+           (first-stem (if (not (null? stems-grobs))
+                          (car stems-grobs)
+                          '()))
+           (note-heads (if (not (null? first-stem))
+                          (ly:grob-object first-stem 'note-heads)
+                          '()))
+           (note-heads-grobs (if (not (null? note-heads))
+                                (ly:grob-array->list note-heads)
+                                '()))
+           (first-note-head (if (not (null? note-heads-grobs))
+                               (car note-heads-grobs)
+                               '()))
+           (style (if (not (null? first-note-head))
+                     (ly:grob-property first-note-head 'style)
+                     '())))
+          (if (and (symbol? style) (string-match "kievan*" (symbol->string style)))
+              (let* ((next-stem (cadr stems-grobs))
+                     (next-note-heads (if (not (null? next-stem))
+                                         (ly:grob-object next-stem 'note-heads)
+                                         '()))
+                     (next-note-heads-grobs (if (not (null? next-note-heads))
+                                               (ly:grob-array->list next-note-heads)
+                                               '()))
+                     (next-note-head (if (not (null? next-note-heads-grobs))
+                                        (car next-note-heads-grobs)
+                                        '()))
+                     (left-pos (ly:grob-property first-note-head 'Y-offset))
+                     (right-pos (ly:grob-property next-note-head 'Y-offset))
+                     (direction (ly:grob-property grob 'direction))
+                     (left-height (if (= direction DOWN)
+                                     (+ (car (ly:grob::stencil-height first-note-head)) 0.75)
+                                      (- (cdr (ly:grob::stencil-height first-note-head)) 0.75)))
+                     (right-height (if (= direction DOWN)
+                                      (+ (car (ly:grob::stencil-height next-note-head)) 0.75)
+                                       (- (cdr (ly:grob::stencil-height next-note-head)) 0.75))))
+                    (cons (+ left-pos left-height) (+ right-pos right-height)))
+              (ly:beam::set-stem-lengths grob))))
+
 ;; calculates each slope of a broken beam individually
 (define-public (beam::place-broken-parts-individually grob)
   (ly:beam::quanting grob '(+inf.0 . -inf.0) #f))
@@ -119,13 +206,25 @@
 (define-public (stem::length grob)
   (let* ((ss (ly:staff-symbol-staff-space grob))
          (beg (ly:grob-property grob 'stem-begin-position))
-         (beam (ly:grob-object grob 'beam)))
-    (if (null? beam)
-        (abs (- (ly:stem::calc-stem-end-position grob) beg))
+         (beam (ly:grob-object grob 'beam))
+         (note-heads (ly:grob-object grob 'note-heads))
+         (note-heads-grobs (if (not (null? note-heads))
+                              (ly:grob-array->list note-heads)
+                              '()))
+         (first-note-head (if (not (null? note-heads-grobs))
+                             (car note-heads-grobs)
+                             '()))
+         (style (if (not (null? first-note-head))
+                    (ly:grob-property first-note-head 'style)
+                   '())))
+    (cond
+      ((and (symbol? style) (string-match "kievan*" (symbol->string style))) 0.0)
+      ((null? beam) (abs (- (ly:stem::calc-stem-end-position grob) beg)))
+      (else
         (begin
           (ly:programming-error
             "stem::length called but will not be used for beamed stem.")
-          0.0))))
+          0.0)))))
 
 (define-public (stem::pure-length grob beg end)
   (let* ((ss (ly:staff-symbol-staff-space grob))