]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/tablature.scm
Run grand-replace for 2010.
[lilypond.git] / scm / tablature.scm
index 883b09ae1c1a8f19e84286aef09ad942e0327ab1..702d15108b187a64184462978f887bd0335f6a32 100644 (file)
@@ -1,8 +1,19 @@
-;;;; tablature.scm
+;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;
-;;;; source file of the GNU LilyPond music typesetter
+;;;; Copyright (C) 2009--2010 Marc Hohl <marc@hohlart.de>
 ;;;;
-;;;; (c) 2009 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
+;;;; the Free Software Foundation, either version 3 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; LilyPond is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
 
 ;; default tunings for common string instruments
 ;; guitar tunings
 ;; convert 5-string banjo tuning to 4-string by removing the 5th string
 (define-public (four-string-banjo tuning)
   (reverse (cdr (reverse tuning))))
+;; ukulele tunings
+(define-public ukulele-tuning '(9 4 0 7)) ;ukulele  a' e' c' g'
+(define-public ukulele-d-tuning '(11 6 2 9)) ;ukulele d tuning, b' fis' d' a'
+(define-public ukulele-tenor-tuning '(-5 0 4 9)) ;tenor ukulele, g c' e' a'
+(define-public ukulele-baritone-tuning '(-10 -5 -1 4)) ;baritone ukulele, d g b e'
+
 
 ;; for more control over glyph-name calculations,
-;; we use a custom callback for tab noteheads
+;; we use a custom callback for tab note heads
 ;; which will ignore 'style = 'do
 (define-public (tab-note-head::calc-glyph-name grob)
   (let ((style (ly:grob-property grob 'style)))
@@ -41,7 +58,7 @@
     (case style
       ((cross) "2cross"))))
 
-;; ensure we only call notehead callback when
+;; ensure we only call note head callback when
 ;; 'style = 'cross
 (define-public (tab-note-head::whiteout-if-style-set grob)
   (let ((style (ly:grob-property grob 'style)))
 (add-new-clef "moderntab" "markup.moderntab" 0 0 0)
 
 ;; define sans serif-style tab-Clefs as a markup:
-(define-builtin-markup-command (customTabClef
+(define-markup-command (customTabClef
                                 layout props num-strings staff-space)
   (integer? number?)
-  music
-  ()
+  #:category music
   "Draw a tab clef sans-serif style."
   (define (square x) (* x x))
   (let* ((scale-factor (/ staff-space 1.5))
@@ -83,7 +99,9 @@
     (if (string=? glyph "markup.moderntab")
         ;; if it is "moderntab", we'll draw it
         (let* ((staff-symbol (ly:grob-object grob 'staff-symbol))
-               (line-count (ly:grob-property staff-symbol 'line-count))
+               (line-count (if (ly:grob? staff-symbol)
+                              (ly:grob-property staff-symbol 'line-count)
+                              0))
                (staff-space (ly:staff-symbol-staff-space grob)))
 
           (grob-interpret-markup grob (make-customTabClef-markup line-count
                 (vector-ref (assoc-get 'break-visibility
                                        tied-properties #(#f #f #t)) 2)))
 
-              (if tab-note-head-visible
-                 ;; tab note head is visible
-                 (if tab-note-head-parenthesized
-                     (ly:grob-set-property! tied-tab-note-head 'stencil
-                                            (lambda (grob)
-                                                    (parenthesize-tab-note-head grob))))
-                 ;; tab note head is invisible
-                 (ly:grob-set-property! tied-tab-note-head 'transparent #t)))
+         (if tab-note-head-visible
+             ;; tab note head is visible
+             (if tab-note-head-parenthesized
+                 (ly:grob-set-property! tied-tab-note-head 'stencil
+                                        (lambda (grob)
+                                          (parenthesize-tab-note-head grob))))
+             ;; tab note head is invisible
+             (begin
+               (ly:grob-set-property! tied-tab-note-head 'transparent #t)
+               (ly:grob-set-property! tied-tab-note-head 'whiteout #f))))
 
         ;; tie is not split -> make fret number invisible
-        (ly:grob-set-property! tied-tab-note-head 'transparent #t))))
+        (begin
+          (ly:grob-set-property! tied-tab-note-head 'transparent #t)
+          (ly:grob-set-property! tied-tab-note-head 'whiteout #f)))))
 
 ;; repeat ties occur within alternatives in a repeat construct;
 ;; TabNoteHead #'details handles the appearance in this case
          (tab-note-head-visible (assoc-get 'note-head-visible repeat-tied-properties #t))
          (tab-note-head-parenthesized (assoc-get 'parenthesize repeat-tied-properties #t)))
 
-        (if tab-note-head-visible
-            ;; tab note head is visible
-            ( if tab-note-head-parenthesized
-                 (ly:grob-set-property! tied-tab-note-head 'stencil
-                                        (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
+    (if tab-note-head-visible
+       ;; tab note head is visible
+       (if tab-note-head-parenthesized
+           (ly:grob-set-property! tied-tab-note-head 'stencil
+                                  (lambda (grob)
+                                    (parenthesize-tab-note-head grob))))
+       ;; tab note head is invisible
+       (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-space (ly:staff-symbol-staff-space grob))
+         (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)))