Implements padding at right-broken hairpins that come up against span bars.

[lilypond.git] / scm / output-lib.scm

diff --git a/scm/output-lib.scm b/scm/output-lib.scm
index 82703e14ac1f0bc9ae336ce5f227aa274edcae41..84f9984b3399eb57b443da13b284d9f7be6b81d1 100644 (file)
--- a/scm/output-lib.scm
+++ b/scm/output-lib.scm
@@ -58,7 +58,6 @@
 
     (ly:text-interface::interpret-markup layout props text)))
 
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; beam slope
 
@@ -390,9 +389,41 @@ and duration-log @var{log}."
           (equal? (ly:item-break-dir g) RIGHT))
       (ly:grob-translate-axis! g 3.5 X)))
 
-(define-public (span-bar-stub::height grob)
-  (ly:grob-property grob 'elements-filtered)
-  (ly:axis-group-interface::height grob))
+(define-public (pure-from-neighbor-interface::extra-spacing-height-at-beginning-of-line grob)
+  (if (= 1 (ly:item-break-dir grob))
+      (pure-from-neighbor-interface::extra-spacing-height grob)
+      (cons -0.1 0.1)))
+
+(define-public (pure-from-neighbor-interface::extra-spacing-height grob)
+  (let* ((height (ly:grob::stencil-height grob))
+         (from-neighbors (interval-union
+                            height
+                            (ly:axis-group-interface::pure-height
+                              grob
+                              0
+                              10000000))))
+    (coord-operation - from-neighbors height)))
+
+(define-public (pure-from-neighbor-interface::account-for-span-bar grob)
+  (let* ((esh (pure-from-neighbor-interface::extra-spacing-height grob))
+         (hsb (ly:grob-property grob 'has-span-bar))
+         (ii (interval-intersection esh (cons -1.01 1.01))))
+    (if (pair? hsb)
+        (cons (car (if (and (car hsb)
+                       (ly:grob-property grob 'allow-span-bar))
+                       esh ii))
+              (cdr (if (cdr hsb) esh ii)))
+        ii)))
+
+(define-public (pure-from-neighbor-interface::extra-spacing-height-including-staff grob)
+  (let ((esh (pure-from-neighbor-interface::extra-spacing-height grob))
+        (to-staff (coord-operation -
+                                   (interval-widen
+                                     '(0 . 0)
+                                     (ly:staff-symbol-staff-radius grob))
+                                   (ly:grob::stencil-height grob))))
+    (interval-union esh to-staff)))
+
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Tuplets