X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fpredefined-fretboards.scm;h=5f4d7005cd518af052ee8d7bee690ce5d5529be7;hb=90e4d7057f3857da049dfda3d130017d4719bd6b;hp=7040add95ee10eb3d0258f30a23a0651f5cc29aa;hpb=7ffb44d7dbcd7bcf66ab0b0ef64515af416f3709;p=lilypond.git

diff --git a/scm/predefined-fretboards.scm b/scm/predefined-fretboards.scm
index 7040add95e..5f4d7005cd 100644
--- a/scm/predefined-fretboards.scm
+++ b/scm/predefined-fretboards.scm
@@ -1,68 +1,54 @@
-;;;;  predefined-fretboards.scm
+;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;
-;;;;  source file of the GNU LilyPOnd music typesetter
+;;;; Copyright (C) 2008--2015 Carl D. Sorensen <c_sorensen@byu.edu>
 ;;;;
-;;;; (c) 2008 Carl D. Sorensen <c_sorensen@byu.edu>
+;;;; 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/>.
 
 
 (define-public (parse-terse-string terse-definition)
-"Parse a fret-diagram-terse definition string @code{terse-definition} and
-return a marking list, which can be used as with a fretboard grob."
-   (cdr (fret-parse-terse-definition-string (list '()) terse-definition)))
-
-(define-public (get-chord-shape shape-code base-chord-shapes)
-"Return the chord shape associated with key @code{shape-code} in
-the alist @code{base-chord-shapes}."
-   (assoc-get shape-code base-chord-shapes #f))
-
-(define-public (offset-fret fret-offset terse-string)
-"Add @code{fret-offset} to each fret indication in @code{terse-string}
-and return the resulting fret-diagram-terse definition string."
-
-   (define (split-fretstring fret-string)
-     (map (lambda (x) (split-item x))
-          (string-split fret-string #\sp )))
-
-   (define (split-item item-string)
-     (string-split item-string #\- ))
-
-   (define (split-terse-string terse-string)
-      (let ((long-list
-               (string-split terse-string #\;)))
-        (map (lambda (x) (split-fretstring x))
-           (list-head long-list (1- (length long-list))))))
-
-   (define (join-terse-string terse-string-list)
-     (string-join
-        (map (lambda (x) (join-fretstring x)) terse-string-list)
-        ";" 'suffix))
-
-   (define (join-item item-list)
-     (string-join item-list "-" ))
-
-   (define (join-fretstring fretstring-list)
-     (string-join
-       (map (lambda (x) (join-item x)) fretstring-list)
-       " " ))
-
-  (define (add-item-fret-offset fret-offset item-list)
-     (let ((fretval (string->number (car item-list))))
-       (if fretval
-           (cons (number->string (+ fretval fret-offset))
-                 (cdr item-list))
-           item-list)))
-
-  (define (add-fretstring-fret-offset fret-offset fretstring-list)
-    (map (lambda (x) (add-item-fret-offset fret-offset x))
-         fretstring-list))
-
-  (define (add-terse-fret-offset fret-offset terse-string-list)
-    (map (lambda (x) (add-fretstring-fret-offset fret-offset x))
-         terse-string-list))
-
-;; body
-  (join-terse-string
-    (add-terse-fret-offset
-      fret-offset
-      (split-terse-string terse-string))))
-
+  "Parse a @code{fret-diagram-terse} definition string @var{terse-definition}
+and return a marking list, which can be used with a fretboard grob."
+  (cdr (fret-parse-terse-definition-string (list '()) terse-definition)))
+
+(define-public (get-chord-shape shape-code tuning base-chord-shapes)
+  "Return the chord shape associated with @var{shape-code} and
+@var{tuning} in the hash-table @var{base-chord-shapes}."
+  (let ((hash-handle (hash-get-handle base-chord-shapes
+                                      (cons shape-code tuning))))
+    (if hash-handle
+        (cdr hash-handle)
+        '())))
+
+(define-public (offset-fret fret-offset diagram-definition)
+  "Add @var{fret-offset} to each fret indication in
+@var{diagram-definition} and return the resulting verbose
+@code{fret-diagram-definition}."
+  (let ((verbose-definition
+         (if (string? diagram-definition)
+             (parse-terse-string diagram-definition)
+             diagram-definition)))
+    (map (lambda (item)
+           (let* ((code (car item))
+                  (nth (assq-ref '((barre . 3) (capo . 1) (place-fret . 2))
+                                 code)))
+             (if nth
+                 ;; offset nth element of item by offset-fret
+                 ;; without modifying the original list but
+                 ;; sharing its tail
+                 (let ((tail (list-tail item nth)))
+                   (append! (list-head item nth)
+                            (cons (+ (car tail) fret-offset)
+                                  (cdr tail))))
+                 item)))
+         verbose-definition)))