From 3cb4d8d3c53d318c6a388bd325382975c077f8af Mon Sep 17 00:00:00 2001
From: Maximilian Albert <address@hidden(none)>
Date: Sat, 13 Dec 2008 00:52:27 +0100
Subject: [PATCH] New grob-property 'shifted-towards-stem (allows scripts to be placed anywhere between the note head and the stem)

---
 lily/script-interface.cc       |    1 +
 scm/define-grob-properties.scm |    4 ++++
 scm/output-lib.scm             |   19 ++++++++++++++++++-
 scm/script.scm                 |    1 +
 4 files changed, 24 insertions(+), 1 deletions(-)

diff --git a/lily/script-interface.cc b/lily/script-interface.cc
index a525500..af2b8f9 100644
--- a/lily/script-interface.cc
+++ b/lily/script-interface.cc
@@ -129,6 +129,7 @@ ADD_INTERFACE (Script_interface,
 	       "positioning-done "
 	       "script-priority "
 	       "script-stencil "
+	       "toward-stem-shift "
 	       "slur "
 	       "slur-padding "
 	       );
diff --git a/scm/define-grob-properties.scm b/scm/define-grob-properties.scm
index b697af3..d9e5691 100644
--- a/scm/define-grob-properties.scm
+++ b/scm/define-grob-properties.scm
@@ -551,6 +551,10 @@ value @code{-1} means left aligned, @address@hidden, and
 values may also be specified.")
      (self-alignment-Y ,number? "Like @code{self-alignment-X} but for
 the address@hidden")
+     (toward-stem-shift ,number? "Amount by which scripts are shifted
+toward the stem if their direction coincides with the stem direction.
address@hidden means keep the default position (centered on the note head),
address@hidden means centered on the stem. Interpolated values are possible.")
      (shorten-pair ,number-pair? "The lengths to shorten a
 text-spanner on both sides, for example a pedal bracket.  Positive
 values shorten the text-spanner, while negative values lengthen it.")
diff --git a/scm/output-lib.scm b/scm/output-lib.scm
index b93edda..1b231d4 100644
--- a/scm/output-lib.scm
+++ b/scm/output-lib.scm
@@ -669,4 +669,21 @@ centered, X==1 is at the right, X == -1 is at the left."
 
 (define-public (script-interface::calc-x-offset grob)
   (ly:grob-property grob 'positioning-done)
-  (ly:self-alignment-interface::centered-on-x-parent grob))
+  (let* ((shift (ly:grob-property grob 'toward-stem-shift 0.0))
+	 (note-head-location (ly:self-alignment-interface::centered-on-x-parent grob))
+	 (note-head-grob (ly:grob-parent grob X))
+	 (stem-grob (ly:grob-object note-head-grob 'stem)))
+    (+ note-head-location
+       ;; If the property 'toward-stem-shift is defined and the script has the
+       ;; same direction as the stem, move the script accordingly. Since scripts can
+       ;; also be over skips, we need to check whether the grob has a stem at all.
+       (if (ly:grob? stem-grob)
+	   (let ((dir1 (ly:grob-property grob 'direction))
+		 (dir2 (ly:grob-property stem-grob 'direction)))
+	     (if (equal? dir1 dir2)
+		 (let* ((common-refp (ly:grob-common-refpoint grob stem-grob X))
+			(stem-location (ly:grob-relative-coordinate stem-grob common-refp X)))
+		   (* shift (- stem-location
+			       note-head-location)))
+		 0.0))
+	   0.0))))
diff --git a/scm/script.scm b/scm/script.scm
index eb2fad5..5e2a2a9 100644
--- a/scm/script.scm
+++ b/scm/script.scm
@@ -111,6 +111,7 @@
       (side-relative-direction .  -1)
       (quantize-position . #t)
       (avoid-slur . inside) 
+      (toward-stem-shift . 0.5)
       (padding . 0.20)	   
       (script-priority . -100)))
     ("tenuto" .
-- 
1.5.4.3