- (set! free-strings (map 1+ (iota (length tuning))))
-
- ;; get defined-strings same length as notes
- (pad-list defined-strings notes)
-
- ;; get defined-fingers same length as notes
- (pad-list defined-fingers notes)
-
- ;; handle notes with strings assigned and fingering of 0
- (for-each
- (lambda (note string finger)
- (let ((digit (if (null? finger)
- #f
- finger)))
- (if (and (null? string)
- (not (eq? digit 0)))
- (set! unassigned-notes (cons note unassigned-notes))
- (if (eq? digit 0)
- (let ((fit-string
- (find (lambda (string)
- (open-string string (note-pitch note)))
- free-strings)))
- (if fit-string
- (begin
- (delete-free-string fit-string)
- (set-fret note fit-string))
- (begin
- (ly:warning (_ "No open string for pitch ~a")
- (note-pitch note))
- (set! unassigned-notes (cons note unassigned-notes)))))
- (let ((this-fret (calc-fret (note-pitch note) string tuning))
- (handle-negative
- (ly:context-property context
- 'handleNegativeFrets
- 'recalculate)))
- (cond ((or (>= this-fret 0)
- (eq? handle-negative 'include))
- (begin
- (delete-free-string string)
- (set-fret note string)))
- ((eq? handle-negative 'recalculate)
- (begin
- (ly:warning (_ "Requested string for pitch requires negative fret: string ~a pitch ~a") string (note-pitch note))
- (ly:warning (_ "Ignoring string request."))
- (set! unassigned-notes (cons note unassigned-notes))))))))))
- notes defined-strings defined-fingers)
-
- ;; handle notes without strings assigned
- (for-each
- (lambda (note)
- (let ((fit-string
- (find (lambda (string)
- (string-qualifies string (note-pitch note)))
- free-strings)))
- (if fit-string
- (set-fret note fit-string)
- (ly:warning (_ "No string for pitch ~a (given frets ~a)")
- (note-pitch note)
- specified-frets))))
- (sort unassigned-notes note-pitch>?))
-
- string-fret-fingering-tuples) ;; end of determine-frets-and-strings
+ (let* ((pitches (map note-pitch notes))
+ (pitch-alist (map cons pitches (iota (length pitches)))))
+
+ ;; handle notes with strings assigned and fingering of 0
+ (for-each
+ (lambda (pitch-entry string-fret-finger)
+ (let* ((string (list-ref string-fret-finger 0))
+ (finger (if (= (length string-fret-finger) 3)
+ (list-ref string-fret-finger 2)
+ '()))
+ (pitch (car pitch-entry))
+ (digit (if (null? finger)
+ #f
+ finger)))
+ (if (or (not (null? string))
+ (eqv? digit 0))
+ (if (eqv? digit 0)
+ ;; here we handle fingers of 0 -- open strings
+ (let ((fit-string
+ (find (lambda (string)
+ (open-string string pitch))
+ free-strings)))
+ (if fit-string
+ (set-fret! pitch-entry fit-string #f)
+ (ly:warning (_ "No open string for pitch ~a")
+ pitch)))
+ ;; here we handle assigned strings
+ (let* ((this-fret
+ (calc-fret pitch string tuning))
+ (possible-fret?
+ (and (>= this-fret 0)
+ (if (and
+ (ly:context-property
+ context 'supportNonIntegerFret #f)
+ (null? rest))
+ (integer? (truncate this-fret))
+ (integer? this-fret))))
+ (handle-negative
+ (ly:context-property context
+ 'handleNegativeFrets
+ 'recalculate)))
+ (cond ((or possible-fret?
+ (eq? handle-negative 'include))
+ (set-fret! pitch-entry string finger))
+ ((eq? handle-negative 'recalculate)
+ (begin
+ (ly:warning
+ (_ "Requested string for pitch requires negative fret: string ~a pitch ~a")
+ string
+ pitch)
+ (ly:warning (_ "Ignoring string request and recalculating."))
+ (list-set! string-fret-fingers
+ (cdr pitch-entry)
+ (if (null? finger)
+ (list '() #f)
+ (list '() #f finger)))))
+ ((eq? handle-negative 'ignore)
+ (begin
+ (ly:warning
+ (_ "Requested string for pitch requires negative fret: string ~a pitch ~a")
+ string
+ pitch)
+ (ly:warning (_ "Ignoring note in tablature."))
+ (kill-note! string-fret-fingers
+ (cdr pitch-entry))))))))))
+ pitch-alist string-fret-fingers)
+ ;; handle notes without strings assigned -- sorted by pitch, so
+ ;; we need to use the alist to have the note number available
+ (for-each
+ (lambda (pitch-entry)
+ (let* ((string-fret-finger (list-ref string-fret-fingers
+ (cdr pitch-entry)))
+ (string (list-ref string-fret-finger 0))
+ (finger (if (= (length string-fret-finger) 3)
+ (list-ref string-fret-finger 2)
+ '()))
+ (pitch (car pitch-entry))
+ (fit-string
+ (find (lambda (string)
+ (string-qualifies string pitch))
+ free-strings)))
+ (if (not (list-ref string-fret-finger 1))
+ (if fit-string
+ (set-fret! pitch-entry fit-string finger)
+ (begin
+ (ly:event-warning
+ (list-ref notes (cdr pitch-entry))
+ (_ "No string for pitch ~a (given frets ~a)")
+ pitch
+ specified-frets)
+ (kill-note! string-fret-fingers
+ (cdr pitch-entry)))))))
+ (sort pitch-alist (lambda (pitch-entry-a pitch-entry-b)
+ (ly:pitch<? (car pitch-entry-b)
+ (car pitch-entry-a)))))
+ string-fret-fingers)) ;; end of determine-frets-and-strings