X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fpredefined-fretboards.scm;h=5f4d7005cd518af052ee8d7bee690ce5d5529be7;hb=HEAD;hp=ff0200729d230881949b1e18aeb8a3a86b5cf985;hpb=1528c75809ebc59d93018dbf59559436f75f082b;p=lilypond.git diff --git a/scm/predefined-fretboards.scm b/scm/predefined-fretboards.scm index ff0200729d..5f4d7005cd 100644 --- a/scm/predefined-fretboards.scm +++ b/scm/predefined-fretboards.scm @@ -1,6 +1,6 @@ ;;;; This file is part of LilyPond, the GNU music typesetter. ;;;; -;;;; Copyright (C) 2008--2011 Carl D. Sorensen +;;;; Copyright (C) 2008--2015 Carl D. Sorensen ;;;; ;;;; LilyPond is free software: you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by @@ -19,40 +19,36 @@ (define-public (parse-terse-string terse-definition) "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))) + (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) - '()))) + (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))) - (cond - ((eq? code 'barre) - (list-set! item 3 - (+ fret-offset (list-ref item 3))) - item) - ((eq? code 'capo) - (list-set! item 1 - (+ fret-offset (list-ref item 1))) - item) - ((eq? code 'place-fret) - (list-set! item 2 - (+ fret-offset (list-ref item 2))) - item) - (else item)))) - verbose-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)))