- (let* ((fret-count 4)
- (string-count 6)
- (fret-range (cons 1 fret-count))
- (barre-list '())
- (dot-list '())
- (xo-list '())
- (output-list '())
- (new-props '())
- (details (merge-details 'fret-diagram-details props '()))
- (items (string-split definition-string #\;)))
- (let parse-item ((myitems items))
- (if (not (null? (cdr myitems)))
- (let ((test-string (car myitems)))
- (case (car (string->list (substring test-string 0 1)))
- ((#\s) (let ((size (get-numeric-from-key test-string)))
- (set! props (prepend-alist-chain 'size size props))))
- ((#\f) (let* ((finger-code (get-numeric-from-key test-string))
- (finger-id (case finger-code
- ((0) 'none)
- ((1) 'in-dot)
- ((2) 'below-string))))
- (set! details
- (acons 'finger-code finger-id details))))
- ((#\c) (set! output-list
- (cons-fret
- (cons
- 'barre
- (numerify
- (string-split (substring test-string 2) #\-)))
- output-list)))
- ((#\h) (let ((fret-count (get-numeric-from-key test-string)))
- (set! details
- (acons 'fret-count fret-count details))))
- ((#\w) (let ((string-count (get-numeric-from-key test-string)))
- (set! details
- (acons 'string-count string-count details))))
- ((#\d) (let ((dot-size (get-numeric-from-key test-string)))
- (set! details
- (acons 'dot-radius dot-size details))))
- ((#\p) (let ((dot-position (get-numeric-from-key test-string)))
- (set! details
- (acons 'dot-position dot-position details))))
- (else
- (let ((this-list (string-split test-string #\-)))
- (if (string->number (cadr this-list))
- (set! output-list
- (cons-fret
- (cons 'place-fret (numerify this-list))
- output-list))
- (if (equal? (cadr this-list) "x" )
- (set! output-list
- (cons-fret
- (list 'mute (string->number (car this-list)))
- output-list))
- (set! output-list
- (cons-fret
- (list 'open (string->number (car this-list)))
- output-list)))))))
- (parse-item (cdr myitems)))))
- ; add the modified details
- (set! props
- (prepend-alist-chain 'fret-diagram-details details props))
- `(,props . ,output-list))) ;ugh -- hard-coded spell -- procedure better
+ (let* ((fret-count 4)
+ (string-count 6)
+ (fret-range (cons 1 fret-count))
+ (barre-list '())
+ (dot-list '())
+ (xo-list '())
+ (output-list '())
+ (new-props '())
+ (details (merge-details 'fret-diagram-details props '()))
+ ;; remove whitespace-characters from definition-string
+ (cleared-string (remove-whitespace definition-string))
+ (items (string-split cleared-string #\;)))
+ (let parse-item ((myitems items))
+ (if (not (null? (cdr myitems)))
+ (let ((test-string (car myitems)))
+ (case (car (string->list (substring test-string 0 1)))
+ ((#\s) (let ((size (get-numeric-from-key test-string)))
+ (set! props (prepend-alist-chain 'size size props))))
+ ((#\t) (let ((th (get-numeric-from-key test-string)))
+ (set! props (prepend-alist-chain 'thickness th props))))
+ ((#\f) (let* ((finger-code (get-numeric-from-key test-string))
+ (finger-id (case finger-code
+ ((0) 'none)
+ ((1) 'in-dot)
+ ((2) 'below-string))))
+ (set! details
+ (acons 'finger-code finger-id details))))
+ ((#\c) (set! output-list
+ (cons-fret
+ (cons
+ 'barre
+ (numerify
+ (string-split (substring test-string 2) #\-)))
+ output-list)))
+ ((#\h) (let ((fret-count (get-numeric-from-key test-string)))
+ (set! details
+ (acons 'fret-count fret-count details))))
+ ((#\w) (let ((string-count (get-numeric-from-key test-string)))
+ (set! details
+ (acons 'string-count string-count details))))
+ ((#\d) (let ((dot-size (get-numeric-from-key test-string)))
+ (set! details
+ (acons 'dot-radius dot-size details))))
+ ((#\p) (let ((dot-position (get-numeric-from-key test-string)))
+ (set! details
+ (acons 'dot-position dot-position details))))
+ (else
+ (let* ((this-list (string-split test-string #\-))
+ (fret-number (string->number (car this-list))))
+ ;; If none of the above applies, `fret-number' needs to be a
+ ;; number. Throw an error, if not.
+ (if (not fret-number)
+ (ly:error
+ "Unhandled entry in fret-diagrams \"~a\" in \"~a\""
+ (car this-list)
+ test-string))
+ (if (string->number (cadr this-list))
+ (set! output-list
+ (cons-fret
+ (cons 'place-fret (numerify this-list))
+ output-list))
+ (if (equal? (cadr this-list) "x" )
+ (set! output-list
+ (cons-fret
+ (list 'mute fret-number)
+ output-list))
+ (set! output-list
+ (cons-fret
+ (list 'open fret-number)
+ output-list)))))))
+ (parse-item (cdr myitems)))))
+ ;; add the modified details
+ (set! props
+ (prepend-alist-chain 'fret-diagram-details details props))
+ `(,props . ,output-list))) ;ugh -- hard-coded spell -- procedure better