X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Ftablature.scm;h=97f688c1d1e868d4242d3a085ab9d4856e3fddf3;hb=HEAD;hp=d62f0aa0178211e5d4e58b3216aefedc233c6319;hpb=cf137655b7aee9988ef536d6fa5e38d279ee73cf;p=lilypond.git

diff --git a/scm/tablature.scm b/scm/tablature.scm
index d62f0aa017..97f688c1d1 100644
--- a/scm/tablature.scm
+++ b/scm/tablature.scm
@@ -1,6 +1,6 @@
 ;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;
-;;;; Copyright (C) 2009--2012 Marc Hohl <marc@hohlart.de>
+;;;; Copyright (C) 2009--2015 Marc Hohl <marc@hohlart.de>
 ;;;;
 ;;;; LilyPond is free software: you can redistribute it and/or modify
 ;;;; it under the terms of the GNU General Public License as published by
@@ -23,17 +23,18 @@
   (let ((style (ly:grob-property grob 'style)))
 
     (case style
-      ((cross) "2cross"))))
+      ((cross) "2cross")
+      ((slash) "2slash")
+      (else #f))))
 
 ;; ensure we only call note head callback when
-;; 'style = 'cross
+;; style is set to a known value
 (define-public (tab-note-head::whiteout-if-style-set grob)
   (let ((style (ly:grob-property grob 'style)))
 
-    (if (and (symbol? style)
-             (eq? style 'cross))
-        (stencil-whiteout (ly:note-head::print grob))
-        (tab-note-head::print grob))))
+    (case style
+      ((cross slash) (stencil-whiteout-box (ly:note-head::print grob)))
+      (else (tab-note-head::print grob)))))
 
 ;; definitions for the "moderntab" clef:
 ;; the "moderntab" clef will be added to the list of known clefs,
@@ -80,23 +81,33 @@
 ;; (dotted) half notes to distinguish them from quarter notes:
 (define-public (tabvoice::make-double-stem-width-for-half-notes grob)
   (let ((X-extent (ly:stem::width grob)))
-
-    ;; is the note a (dotted) half note?
-    (if (= 1 (ly:grob-property grob 'duration-log))
-        ;; yes -> return double stem width
-        (cons (car X-extent) (+ 0.5 (* 2 (cdr X-extent))))
-        ;; no -> return simple stem width
-        X-extent)))
+    ;; does the stem exist and is it on a (dotted) half note?
+    (if (and (not (equal? X-extent empty-interval))
+             (= 1 (ly:grob-property grob 'duration-log)))
+
+      ;; yes -> return double stem X-extent
+      (let* ((single-stem-width (- (cdr X-extent) (car X-extent)))
+             (separation (ly:grob-property grob 'double-stem-separation 0.5))
+             (total-width (+ single-stem-width separation))
+             (half-width (/ total-width 2)))
+        (cons (- half-width) half-width))
+      ;; no -> return simple stem X-extent
+      X-extent)))
 
 (define-public (tabvoice::draw-double-stem-for-half-notes grob)
-  (let ((stem (ly:stem::print grob)))
-
-    ;; is the note a (dotted) half note?
-    (if (= 1 (ly:grob-property grob 'duration-log))
-        ;; yes -> draw double stem
-        (ly:stencil-combine-at-edge stem X RIGHT stem 0.5)
-        ;; no -> draw simple stem
-        stem)))
+  (let ((stem-stencil (ly:stem::print grob)))
+    ;; does the stem exist and is it on a (dotted) half note?
+    (if (and (ly:stencil? stem-stencil)
+             (= 1 (ly:grob-property grob 'duration-log)))
+
+      ;; yes -> draw double stem
+      (let* ((separation (ly:grob-property grob 'double-stem-separation 0.5))
+             (half-separation (/ separation 2)))
+        (ly:stencil-add
+          (ly:stencil-translate-axis stem-stencil (- half-separation) X)
+          (ly:stencil-translate-axis stem-stencil half-separation X)))
+      ;; no -> draw simple stem (or none at all)
+      stem-stencil)))
 
 ;; as default, the glissando line between fret numbers goes
 ;; upwards, here we have a function to correct this behavior:
@@ -223,9 +234,10 @@
 
 
 ;; a callback for custom fret labels
-(define-public ((tab-note-head::print-custom-fret-label fret) grob)
-  (ly:grob-set-property! grob 'text fret)
+(define ((tab-note-head::print-custom-fret-label fret) grob)
+  (ly:grob-set-property! grob 'text (make-vcenter-markup fret))
   (tab-note-head::print grob))
+(export tab-note-head::print-custom-fret-label)
 
 (define-public (tab-note-head::print grob)
   (define (is-harmonic? grob)
@@ -254,9 +266,7 @@
          (offset-factor (assoc-get 'head-offset details 3/5))
          (column-offset (* offset-factor
                            (interval-length
-                            (ly:stencil-extent
-                             (grob-interpret-markup grob "8")
-                             X)))))
+                            (ly:stencil-extent ref-grob X)))))
 
     (if (is-harmonic? grob)
         (set! output-grob (harmonic-proc output-grob
@@ -270,9 +280,10 @@
                                            cautionary-width
                                            cautionary-angularity
                                            cautionary-padding)))
-    (ly:stencil-translate-axis (centered-stencil output-grob)
-                               column-offset
-                               X)))
+    (ly:stencil-translate-axis
+     (ly:stencil-aligned-to output-grob X CENTER)
+     column-offset
+     X)))
 
 ;; Harmonic definitions
 
@@ -376,7 +387,7 @@
         (elt (ly:music-property mus 'element)))
     (cond
      ((pair? elts)
-      (map make-harmonic elts))
+      (for-each make-harmonic elts))
      ((ly:music? elt)
       (make-harmonic elt))
      ((music-is-of-type? mus 'note-event)