From 6684abbd4548e775a6eb90e74a03e9a4ba5d9cee Mon Sep 17 00:00:00 2001
From: Marc Hohl <marc@hohlart.de>
Date: Tue, 6 Oct 2009 10:01:33 +0200
Subject: [PATCH] tablature enhancement: hammer on/pull off

By modifying the stems accordingly, they do not influence the
calculation of the slur control-points, so we minimize problems
using slurs in tablature.

The routine for minimizing the distance between the slur and the
fret number is still not ideal, but should work in most cases.
---
 ly/engraver-init.ly | 22 +++++++++++++++++++---
 ly/property-init.ly |  7 +++++++
 scm/tablature.scm   | 19 ++++++++++++++++++-
 3 files changed, 44 insertions(+), 4 deletions(-)

diff --git a/ly/engraver-init.ly b/ly/engraver-init.ly
index 7069652e42..6147b7fd8d 100644
--- a/ly/engraver-init.ly
+++ b/ly/engraver-init.ly
@@ -714,8 +714,24 @@ context."
 
   %% No accidental in tablature !
   \remove "Accidental_engraver"
-  %% remove stems, beams, dots and rests ...
-  \override Stem #'stencil = ##f
+  %% make the Stems as short as possible to minimize their influence 
+  %% on the slur::calc-control-points routine
+  \override Stem #'length = #0
+  \override Stem #'no-stem-extend = ##t
+  \override Stem #'flag-style = #'no-flag
+  \override Stem #'details = #'((lengths 0 0 0 0 0 0)
+                                (beamed-lengths 0 0 0)
+                                (beamed-minimum-free-lengths 0 0 0)
+                                (beamed-extreme-minimum-free-lengths 0 0)
+                                (stem-shorten 0 0))
+  %% after all, the stubs of thestems may still be visible, so ...
+  \override Stem #'transparent = ##t
+  %% automatic beams should be suppressed for similar reasons ...
+  autoBeaming = ##f
+  %% ... and we ignore collision warnings that may occur due to
+  %% stem overlapping ...
+  \override NoteColumn #'ignore-collision = ##t
+  %% remove beams, dots and rests ...
   \override Beam #'stencil = ##f
   \override Dots #'stencil = ##f
   \override Rest #'stencil = ##f
@@ -724,7 +740,7 @@ context."
   \override Tie  #'stencil = ##f
   \override RepeatTie #'stencil = ##f
   \override LaissezVibrerTie #'stencil = ##f
-  \override Slur #'stencil = ##f
+  \override Slur #'stencil = #slur::draw-tab-slur
   \override PhrasingSlur #'stencil = ##f
   %% 'tied to' fret numbers become invisible or parenthesized, respectively)
   \override Tie #'after-line-breaking = #tie::handle-tab-note-head
diff --git a/ly/property-init.ly b/ly/property-init.ly
index b982843cf9..b64c8b577d 100644
--- a/ly/property-init.ly
+++ b/ly/property-init.ly
@@ -375,7 +375,14 @@ tabFullNotation = {
   % time signature
   \revert TabStaff.TimeSignature #'stencil
   % stems (the half note gets a double stem)
+  \revert Stem #'length
+  \revert Stem #'no-stem-extend
+  \revert Stem #'flag-style
+  \revert Stem #'details
+  \revert Stem #'transparent
   \override TabVoice.Stem #'stencil = #tabvoice::draw-double-stem-for-half-notes
+  autoBeaming = ##t
+  \revert NoteColumn #'ignore-collision
   % beams, dots
   \revert TabVoice.Beam #'stencil
   \revert TabVoice.Dots #'stencil
diff --git a/scm/tablature.scm b/scm/tablature.scm
index 883b09ae1c..054f3416d1 100644
--- a/scm/tablature.scm
+++ b/scm/tablature.scm
@@ -204,4 +204,21 @@
                                         (lambda (grob)
                                                 (parenthesize-tab-note-head grob))))
             ;; tab note head is invisible
-            (ly:grob-set-property! tied-tab-note-head 'transparent #t))))
\ No newline at end of file
+            (ly:grob-set-property! tied-tab-note-head 'transparent #t))))
+
+;; the slurs should not be too far apart from the corresponding fret number, so
+;; we move the slur towards the TabNoteHeads:
+#(define-public (slur::draw-tab-slur grob)
+  ;; TODO: use a less "brute-force" method to decrease
+  ;; the distance between the slur ends and the fret numbers
+  (let* ((staff-symbol (ly:grob-object grob 'staff-symbol))
+         (staff-space (ly:grob-property staff-symbol 'staff-space))
+         (control-points (ly:grob-property grob 'control-points))
+         (new-control-points (map (lambda (p)
+                                          (cons (car p) (- (cdr p)
+                                                        (* staff-space
+                                                           (ly:grob-property grob 'direction)
+                                                           0.35))))
+                                  control-points)))
+        (ly:grob-set-property! grob 'control-points new-control-points)
+        (ly:slur::print grob)))
\ No newline at end of file
-- 
2.39.2