scm/predefined-fretboards.scm

   1 ;;;;  predefined-fretboards.scm
   2 ;;;;
   3 ;;;;  source file of the GNU LilyPOnd music typesetter
   4 ;;;;
   5 ;;;; (c) 2008 Carl D. Sorensen <c_sorensen@byu.edu>
   6
   7
   8 (define-public (parse-terse-string terse-definition)
   9 "Parse a fret-diagram-terse definition string @code{terse-definition} and
  10 return a marking list, which can be used as with a fretboard grob."
  11    (cdr (fret-parse-terse-definition-string (list '()) terse-definition)))
  12
  13 (define-public (get-chord-shape shape-code base-chord-shapes)
  14 "Return the chord shape associated with key @code{shape-code} in
  15 the alist @code{base-chord-shapes}."
  16    (assoc-get shape-code base-chord-shapes #f))
  17
  18 (define-public (offset-fret fret-offset terse-string)
  19 "Add @code{fret-offset} to each fret indication in @code{terse-string}
  20 and return the resulting fret-diagram-terse definition string."
  21
  22    (define (split-fretstring fret-string)
  23      (map (lambda (x) (split-item x))
  24           (string-split fret-string #\sp )))
  25
  26    (define (split-item item-string)
  27      (string-split item-string #\- ))
  28
  29    (define (split-terse-string terse-string)
  30       (let ((long-list
  31                (string-split terse-string #\;)))
  32         (map (lambda (x) (split-fretstring x))
  33            (list-head long-list (1- (length long-list))))))
  34
  35    (define (join-terse-string terse-string-list)
  36      (string-join
  37         (map (lambda (x) (join-fretstring x)) terse-string-list)
  38         ";" 'suffix))
  39
  40    (define (join-item item-list)
  41      (string-join item-list "-" ))
  42
  43    (define (join-fretstring fretstring-list)
  44      (string-join
  45        (map (lambda (x) (join-item x)) fretstring-list)
  46        " " ))
  47
  48   (define (add-item-fret-offset fret-offset item-list)
  49      (let ((fretval (string->number (car item-list))))
  50        (if fretval
  51            (cons (number->string (+ fretval fret-offset))
  52                  (cdr item-list))
  53            item-list)))
  54
  55   (define (add-fretstring-fret-offset fret-offset fretstring-list)
  56     (map (lambda (x) (add-item-fret-offset fret-offset x))
  57          fretstring-list))
  58
  59   (define (add-terse-fret-offset fret-offset terse-string-list)
  60     (map (lambda (x) (add-fretstring-fret-offset fret-offset x))
  61          terse-string-list))
  62
  63 ;; body
  64   (join-terse-string
  65     (add-terse-fret-offset
  66       fret-offset
  67       (split-terse-string terse-string))))
  68