- (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
+ (let* ((pitch-alist (apply (lambda (mylist)
+ (let ((index -1))
+ (map (lambda (note)
+ (begin
+ (set! index (1+ index))
+ (cons (note-pitch note)
+ index)))
+ mylist)))
+ notes '()))
+ (pitches (map note-pitch notes)))
+
+ ;; 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 (eq? (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))
+ (eq? digit 0))
+ (if (eq? 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))
+ (handle-negative
+ (ly:context-property context
+ 'handleNegativeFrets
+ 'recalculate)))
+ (cond ((or (>= this-fret 0)
+ (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."))
+ (list-set! string-fret-fingers
+ (cdr pitch-entry)
+ (if (null? finger)
+ (list '() #f)
+ (list '() #f finger)))))))))))
+ 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