+ (barre-type
+ (assoc-get 'barre-type details 'curved))
+ (fret-diagram-stencil
+ (ly:stencil-add
+ (draw-strings
+ string-count fret-range th thickness-factor size orientation)
+ (draw-frets fret-range string-count th size orientation))))
+ (if (and (not (null? barre-list))
+ (not (eq? 'none barre-type)))
+ (set! fret-diagram-stencil
+ (ly:stencil-add
+ (draw-barre layout props string-count fret-range size
+ finger-code dot-position dot-radius
+ barre-list orientation)
+ fret-diagram-stencil)))
+ (if (not (null? dot-list))
+ (set! fret-diagram-stencil
+ (ly:stencil-add
+ fret-diagram-stencil
+ (draw-dots layout props string-count my-fret-count
+ size finger-code dot-position dot-radius
+ th dot-list orientation))))
+ (if (= (car fret-range) 1)
+ (set! fret-diagram-stencil
+ (ly:stencil-add
+ fret-diagram-stencil
+ (draw-thick-zero-fret
+ details string-count th size orientation))))
+ (if (not (null? xo-list))
+ (let* ((diagram-fret-top
+ (car (stencil-fretboard-extent
+ fret-diagram-stencil
+ 'fret
+ orientation)))
+ (xo-stencil
+ (draw-xo layout props string-count fret-range
+ size xo-list orientation))
+ (xo-fret-offset
+ (stencil-fretboard-offset
+ xo-stencil 'fret orientation)))
+ (set! fret-diagram-stencil
+ (ly:stencil-add
+ fret-diagram-stencil
+ (ly:stencil-translate
+ xo-stencil
+ (stencil-coordinates
+ (- diagram-fret-top
+ xo-fret-offset
+ (* size xo-padding))
+ 0 ; no string offset
+ orientation))))))
+
+ (if (> capo-fret 0)
+ (set! fret-diagram-stencil
+ (ly:stencil-add
+ fret-diagram-stencil
+ (draw-capo details string-count capo-fret my-fret-count
+ th size dot-position orientation))))
+ (if (> (car fret-range) 1)
+ (set! fret-diagram-stencil
+ (ly:stencil-add
+ fret-diagram-stencil
+ (label-fret
+ layout props string-count fret-range size orientation))))
+ (ly:stencil-aligned-to
+ (ly:stencil-aligned-to fret-diagram-stencil X alignment)
+ Y 0)))
+
+(define (fret-parse-definition-string props definition-string)
+ "Parse a fret diagram string and return a pair containing:
+@var{props}, modified as necessary by the definition-string
+a fret-indication list with the appropriate values"
+ (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
+
+(define-public
+ (fret-parse-terse-definition-string props definition-string)
+ "Parse a fret diagram string that uses terse syntax;
+return a pair containing:
+@var{props}, modified to include the string-count determined by the
+definition-string, and
+a fret-indication list with the appropriate values"
+;TODO -- change syntax to fret\string-finger
+
+ (let* ((details (merge-details 'fret-diagram-details props '()))
+ (barre-start-list '())
+ (output-list '())
+ (new-props '())
+ (items (string-split definition-string #\;))
+ (string-count (- (length items) 1)))
+ (let parse-item ((myitems items))
+ (if (not (null? (cdr myitems)))
+ (let* ((test-string (car myitems))
+ (current-string (- (length myitems) 1))
+ (indicators (string-split test-string #\ )))
+ (let parse-indicators ((myindicators indicators))
+ (if (not (eq? '() myindicators))
+ (let* ((this-list (string-split (car myindicators) #\-))
+ (max-element-index (- (length this-list) 1))
+ (last-element
+ (car (list-tail this-list max-element-index)))
+ (fret
+ (if (string->number (car this-list))
+ (string->number (car this-list))
+ (car this-list))))
+ (if (equal? last-element "(")
+ (begin
+ (set! barre-start-list
+ (cons-fret (list current-string fret)
+ barre-start-list))
+ (set! this-list
+ (list-head this-list max-element-index))))
+ (if (equal? last-element ")")
+ (let* ((this-barre
+ (get-sub-list fret barre-start-list))
+ (insert-index (- (length this-barre) 1)))
+ (set! output-list
+ (cons-fret (cons* 'barre
+ (car this-barre)
+ current-string
+ (cdr this-barre))
+ output-list))
+ (set! this-list
+ (list-head this-list max-element-index))))
+ (if (number? fret)
+ (set!
+ output-list
+ (cons-fret (cons*
+ 'place-fret
+ current-string
+ (drop-paren (numerify this-list)))
+ output-list))
+ (if (equal? (car this-list) "x" )
+ (set!
+ output-list
+ (cons-fret
+ (list 'mute current-string)
+ output-list))
+ (set!
+ output-list
+ (cons-fret
+ (list 'open current-string)
+ output-list))))
+ (parse-indicators (cdr myindicators)))))
+ (parse-item (cdr myitems)))))
+ (set! details (acons 'string-count string-count details))
+ (set! props (prepend-alist-chain 'fret-diagram-details details props))
+ `(,props . ,output-list))) ; ugh -- hard coded; proc is better
+
+
+(define-builtin-markup-command
+ (fret-diagram-verbose layout props marking-list)
+ (pair?) ; argument type (list, but use pair? for speed)
+ instrument-specific-markup ; markup type
+ ((align-dir -0.4) ; properties and defaults
+ (size 1.0)
+ (fret-diagram-details)
+ (thickness 0.5))
+ "Make a fret diagram containing the symbols indicated in @var{marking-list}.
+
+ For example,
+
+@example
+\\markup \\fret-diagram-verbose
+ #'((mute 6) (mute 5) (open 4)
+ (place-fret 3 2) (place-fret 2 3) (place-fret 1 2))
+@end example
+
+@noindent
+produces a standard D@tie{}chord diagram without fingering indications.
+
+Possible elements in @var{marking-list}:
+
+@table @code
+@item (mute @var{string-number})
+Place a small @q{x} at the top of string @var{string-number}.
+
+@item (open @var{string-number})
+Place a small @q{o} at the top of string @var{string-number}.
+
+@item (barre @var{start-string} @var{end-string} @var{fret-number})
+Place a barre indicator (much like a tie) from string @var{start-string}
+to string @var{end-string} at fret @var{fret-number}.
+
+@item (capo @var{fret-number})
+Place a capo indicator (a large solid bar) across the entire fretboard
+at fret location @var{fret-number}. Also, set fret @var{fret-number}
+to be the lowest fret on the fret diagram.
+
+@item (place-fret @var{string-number} @var{fret-number} @var{finger-value})
+Place a fret playing indication on string @var{string-number} at fret
+@var{fret-number} with an optional fingering label @var{finger-value}.
+By default, the fret playing indicator is a solid dot. This can be
+changed by setting the value of the variable @var{dot-color}. If the
+@var{finger} part of the @code{place-fret} element is present,
+@var{finger-value} will be displayed according to the setting of the
+variable @var{finger-code}. There is no limit to the number of fret
+indications per string.
+@end table"
+
+ (make-fret-diagram layout props marking-list))