-(define-public (determine-frets context grob notes string-numbers)
- (define (ensure-number a b)
- (if (number? a)
- a
- b))
-(let*
- ((tunings (ly:context-property context 'stringTunings))
- (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 max-stretch
- tunings)))
-
-
- (set! (ly:grob-property grob 'string-count) (length tunings))
- (set! (ly:grob-property grob 'string-fret-finger-combinations) string-frets)
-
- ))
-
-(define-public (determine-frets-mf notes string-numbers
- minimum-fret max-stretch
- tunings)
+(define (create-fretboard context grob placement-list)
+ "Convert @var{placement-list} into a fretboard @var{grob}."
+
+ (let* ((tunings (ly:context-property context 'stringTunings))
+ (my-string-count (length tunings))
+ (details (ly:grob-property grob 'fret-diagram-details)))
+
+ ;; Add string-count from string-tunings to fret-diagram-details.
+ (set! (ly:grob-property grob 'fret-diagram-details)
+ (acons 'string-count my-string-count details))
+ ;; Create the dot-placement list for the grob
+ (set! (ly:grob-property grob 'dot-placement-list) placement-list)))
+
+(define-public
+ (determine-frets context notes defined-strings . rest)
+ "Determine string numbers and frets for playing @var{notes}
+as a chord, given specified string numbers @var{defined-strings}.
+Will look for predefined fretboards if @code{predefinedFretboardTable}
+is not @code {#f}. If @var{rest} is present, it contains the
+FretBoard grob, and a fretboard will be
+created. Otherwise, a list of (string fret finger) lists will
+be returned)."
+
+ ;; helper functions
+
+ (define (string-frets->placement-list string-frets string-count)
+ "Convert @var{string-frets} to @code{fret-diagram-verbose}
+dot placement entries."
+ (let* ((placements (list->vector
+ (map (lambda (x) (list 'mute (1+ x)))
+ (iota string-count)))))
+
+ (for-each (lambda (sf)
+ (let* ((string (car sf))
+ (fret (cadr sf))
+ (finger (caddr sf)))
+ (vector-set!
+ placements (1- string)
+ (if (= 0 fret)
+ (list 'open string)
+ (if finger
+ (list 'place-fret string fret finger)
+ (list 'place-fret string fret))))))
+ string-frets)
+ (vector->list placements)))
+
+ (define (placement-list->string-frets placement-list)
+ "Convert @var{placement-list} to string-fret list."
+ (map (lambda (x) (cdr x))
+ (filter (lambda (l) (eq? (cdr l) 'place-fret) placement-list))))
+
+
+ (define (get-predefined-fretboard predefined-fret-table tuning pitches)
+ "Search through @var{predefined-fret-table} looking for a predefined
+fretboard with a key of @var{(tuning . pitches)}. The search will check
+both up and down an octave in order to accomodate transposition of the
+chords. Returns a placement-list."
+
+ (define (get-fretboard key)
+ (let ((hash-handle
+ (hash-get-handle predefined-fret-table key)))
+ (if hash-handle
+ (cdr hash-handle) ; return table entry
+ '())))
+
+ ;; body of get-predefined-fretboard
+ (let ((test-fretboard (get-fretboard (cons tuning pitches))))
+ (if (not (null? test-fretboard))
+ test-fretboard
+ (let ((test-fretboard
+ (get-fretboard
+ (cons tuning (map (lambda (x) (shift-octave x 1)) pitches)))))
+ (if (not (null? test-fretboard))
+ test-fretboard
+ (get-fretboard
+ (cons tuning (map (lambda (x) (shift-octave x -1))
+ pitches))))))))
+
+ ;; body of determine-frets
+ (let* ((predefined-fret-table
+ (ly:context-property context 'predefinedDiagramTable))
+ (tunings (ly:context-property context 'stringTunings))
+ (string-count (length tunings))
+ (grob (if (null? rest) '() (car rest)))
+ (pitches (map (lambda (x) (ly:event-property x 'pitch)) notes))
+ (predefined-fretboard
+ (if predefined-fret-table
+ (get-predefined-fretboard
+ predefined-fret-table
+ tunings
+ pitches)
+ '())))
+
+ (if (null? predefined-fretboard)
+ (let ((string-frets
+ (determine-frets-and-strings
+ notes
+ defined-strings
+ (ly:context-property context 'minimumFret 0)
+ (ly:context-property context 'maximumFretStretch 4)
+ tunings)))
+ (if (null? grob)
+ string-frets
+ (create-fretboard
+ context grob (string-frets->placement-list
+ string-frets string-count))))
+ (if (null? grob)
+ (placement-list->string-frets predefined-fretboard)
+ (create-fretboard context grob predefined-fretboard)))))
+
+
+(define (determine-frets-and-strings
+ notes defined-strings minimum-fret maximum-stretch tuning)