X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Ftranslation-functions.scm;h=6c68f34cb073a88c2b3cfa38dfc089cce0bf9a20;hb=c6b8818201add8f2e2114b5583bca805ac63574a;hp=b6e5d309d8c005d883fa5048f19f08f0b1ce8ed9;hpb=bdb230ec13add661aa43eb5e3216f8074c2b9c8e;p=lilypond.git

diff --git a/scm/translation-functions.scm b/scm/translation-functions.scm
index b6e5d309d8..6c68f34cb0 100644
--- a/scm/translation-functions.scm
+++ b/scm/translation-functions.scm
@@ -1,9 +1,20 @@
-;;;; translation-functions.scm --
-;;;;
-;;;;  source file of the GNU LilyPond music typesetter
+;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;
 ;;;; (c) 1998--2009 Han-Wen Nienhuys <hanwen@xs4all.nl>
 ;;;;		     Jan Nieuwenhuizen <janneke@gnu.org>
+;;;;
+;;;; 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/>.
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -244,16 +255,16 @@
     (set! (ly:grob-property grob 'dot-placement-list)
           (if (not (null? predefined-fretboard))
               predefined-fretboard
-              (let ((minimum-fret
-                     (ensure-number
-                      (ly:context-property context 'minimumFret)
-                      0))
-                    (max-stretch
-                     (ensure-number
-                      (ly:context-property context 'maximumFretStretch)
-                      4))
-                    (string-frets
-                     (determine-frets-mf
+              (let* ((minimum-fret
+                      (ensure-number
+                       (ly:context-property context 'minimumFret)
+                       0))
+                     (max-stretch
+                      (ensure-number
+                       (ly:context-property context 'maximumFretStretch)
+                       4))
+                     (string-frets
+                      (determine-frets-mf
                        notes
                        string-numbers
                        minimum-fret
@@ -374,21 +385,40 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; tablature
 
-;; The TabNoteHead tablatureFormat callback.
-;; Compute the text grob-property
-(define-public (fret-number-tablature-format string context event)
+;; The TabNoteHead tablatureFormat callbacks.
+
+;; Calculate the fret from pitch and string number as letter
+;; The fret letter is taken from 'fretLabels if present
+(define-public (fret-letter-tablature-format string-number context event)
+  (let* ((tuning (ly:context-property context 'stringTunings))
+         (pitch (ly:event-property event 'pitch))
+         (labels (ly:context-property context 'fretLabels))
+         (fret (- (ly:pitch-semitones pitch)
+                  (list-ref tuning (- string-number 1)))))
+    (make-vcenter-markup
+     (cond
+      ((= 0 (length labels))
+       (string (integer->char (+ fret (char->integer #\a)))))
+      ((and (<= 0 fret) (< fret (length labels)))
+       (list-ref labels fret))
+      (else
+       (ly:warning "No label for fret ~a (~a on string ~a);
+only ~a fret labels provided"
+		   fret pitch string-number (length labels))
+       ".")))))
+
+;; Calculate the fret from pitch and string number as number
+(define-public (fret-number-tablature-format string-number context event)
   (let* ((tuning (ly:context-property context 'stringTunings))
 	 (pitch (ly:event-property event 'pitch)))
-
-    (make-whiteout-markup
-     (make-vcenter-markup
-      (format
-       "~a"
-       (- (ly:pitch-semitones pitch)
-	  (list-ref tuning
-		    ;; remove 1 because list index starts at 0
-		    ;;and guitar string at 1.
-		    (1- string))))))))
+    (make-vcenter-markup
+     (format
+      "~a"
+      (- (ly:pitch-semitones pitch)
+         (list-ref tuning
+                   ;; remove 1 because list index starts at 0
+                   ;;and guitar string at 1.
+                   (1- string-number)))))))
 
 ;; The 5-string banjo has got a extra string, the fifth (duh), which
 ;; starts at the fifth fret on the neck.  Frets on the fifth string
@@ -396,17 +426,16 @@
 ;;   the "first fret" on the fifth string is really the sixth fret
 ;;   on the banjo neck.
 ;; We solve this by defining a new fret-number-tablature function:
-(define-public (fret-number-tablature-format-banjo string context event)
+(define-public (fret-number-tablature-format-banjo string-number context event)
   (let* ((tuning (ly:context-property context 'stringTunings))
 	 (pitch (ly:event-property event 'pitch)))
-
-    (make-whiteout-markup
-     (make-vcenter-markup
-      (let ((fret (- (ly:pitch-semitones pitch) (list-ref tuning (1- string)))))
-	(number->string (cond
-			 ((and (> fret 0) (= string 5))
-			  (+ fret 5))
-			 (else fret))))))))
+    (make-vcenter-markup
+      (let ((fret (- (ly:pitch-semitones pitch)
+                     (list-ref tuning (1- string-number)))))
+        (number->string (cond
+                          ((and (> fret 0) (= string-number 5))
+                            (+ fret 5))
+                          (else fret)))))))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;