1 ;;;; fret-diagrams.scm --
3 ;;;; source file of the GNU LilyPond music typesetter
5 ;;;; (c) 2004--2009 Carl D. Sorensen <c_sorensen@byu.edu>
12 (define (string-x-extent start-point end-point)
13 "Return the x-extent of a string that goes from start-point
15 (let ((x1 (car start-point))
21 (define (string-y-extent start-point end-point)
22 "Return the y-extent of a string that goes from start-point
24 (let ((y1 (cdr start-point))
31 (define (cons-fret new-value old-list)
32 "Put together a fret-list in the format desired by parse-string"
33 (if (eq? old-list '())
35 (cons* new-value old-list)))
37 (define (get-numeric-from-key keystring)
38 "Get the numeric value from a key of the form k:val"
39 (string->number (substring keystring 2 (string-length keystring))))
41 (define (numerify mylist)
42 "Convert string values to numeric or character"
45 (let ((numeric-value (string->number (car mylist))))
47 (cons* numeric-value (numerify (cdr mylist)))
48 (cons* (car (string->list (car mylist)))
49 (numerify (cdr mylist)))))))
52 "Calculate the font step necessary to get a desired magnification"
53 (* 6 (/ (log mag) (log 2))))
55 (define (fret-count fret-range)
56 "Calculate the fret count for the diagram given the range of frets in the diagram."
57 (1+ (- (cdr fret-range) (car fret-range))))
59 (define (subtract-base-fret base-fret dot-list)
60 "Subtract @var{base-fret} from every fret in @var{dot-list}"
63 (let ((this-list (car dot-list)))
64 (cons* (list (car this-list) (- (second this-list) base-fret)
65 (if (null? (cddr this-list))
68 (subtract-base-fret base-fret (cdr dot-list))))))
70 (define (drop-paren item-list)
71 "Drop a final parentheses from a fret indication list
72 @code{item-list} resulting from a terse string specification of barre."
73 (if (> (length item-list) 0)
74 (let* ((max-index (- (length item-list) 1))
75 (last-element (car (list-tail item-list max-index))))
76 (if (or (equal? last-element ")") (equal? last-element "("))
77 (list-head item-list max-index)
81 (define (get-sub-list value master-list)
82 "Get a sub-list whose cadr is equal to @var{value} from @var{master-list}"
83 (if (eq? master-list '())
85 (let ((sublist (car master-list)))
86 (if (equal? (cadr sublist) value)
88 (get-sub-list value (cdr master-list))))))
90 (define (merge-details key alist-list . default)
91 "Return @code{alist-list} entries for @code{key}, in one combined alist.
92 There can be two @code{alist-list} entries for a given key. The first
93 comes from the override-markup function, the second comes
94 from property settings during a regular override.
95 This is necessary because some details can be set in one
96 place, while others are set in the other. Both details
97 lists must be merged into a single alist.
98 Return @code{default} (optional, else #f) if not
101 (define (helper key alist-list default)
102 (if (null? alist-list)
104 (let* ((entry (assoc-get key (car alist-list))))
106 (append entry (chain-assoc-get key (cdr alist-list) '()))
107 (helper key (cdr alist-list) default)))))
109 (helper key alist-list
110 (if (pair? default) (car default) #f)))
113 ; Conversions between fret/string coordinate system and x-y coordinate
116 ; Fret coordinates are measured down the fretboard from the nut,
119 ; String coordinates are measured from the lowest string, starting at 0.
121 ; The x-y origin is at the intersection of the nut and the lowest string.
123 ; X coordinates are positive to the right.
124 ; Y coordinates are positive up.
127 (define (negate-extent extent)
128 "Return the extent in an axis opposite to the axis of @code{extent}."
129 (cons (- (cdr extent)) (- (car extent))))
131 (define (stencil-fretboard-extent stencil fretboard-axis orientation)
132 "Return the extent of @code{stencil} in the @code{fretboard-axis}
134 (if (eq? fretboard-axis 'fret)
135 (cond ((eq? orientation 'landscape)
136 (ly:stencil-extent stencil X))
137 ((eq? orientation 'opposing-landscape)
138 (negate-extent (ly:stencil-extent stencil X)))
140 (negate-extent (ly:stencil-extent stencil Y))))
141 ; else -- eq? fretboard-axis 'string
142 (cond ((eq? orientation 'landscape)
143 (ly:stencil-extent stencil Y))
144 ((eq? orientation 'opposing-landscape)
145 (negate-extent (ly:stencil-extent stencil Y)))
147 (ly:stencil-extent stencil Y)))))
150 (define (stencil-fretboard-offset stencil fretboard-axis orientation)
151 "Return a the stencil coordinates of the center of @code{stencil}
152 in the @code{fretboard-axis} direction."
153 (* 0.5 (interval-length
154 (stencil-fretboard-extent stencil fretboard-axis orientation))))
157 (define (string-thickness string thickness-factor)
158 (expt (1+ thickness-factor) (1- string)))
161 ; Functions that create stencils used in the fret diagram
164 (define (sans-serif-stencil layout props mag text)
165 "Create a stencil in sans-serif font based on @var{layout} and @var{props}
166 with magnification @var{mag} of the string @var{text}."
169 'font-size (stepmag mag)
170 (prepend-alist-chain 'font-family 'sans props))))
171 (interpret-markup layout my-props text)))
175 ;; markup commands and associated functions
180 (define (fret-parse-marking-list marking-list my-fret-count)
181 "Parse a fret-diagram-verbose marking list into component sublists"
182 (let* ((fret-range (cons 1 my-fret-count))
188 (let parse-item ((mylist marking-list))
189 (if (not (null? mylist))
190 (let* ((my-item (car mylist)) (my-code (car my-item)))
192 ((or (eq? my-code 'open)(eq? my-code 'mute))
193 (set! xo-list (cons* my-item xo-list)))
194 ((eq? my-code 'barre)
195 (set! barre-list (cons* (cdr my-item) barre-list)))
197 (set! capo-fret (cadr my-item)))
198 ((eq? my-code 'place-fret)
199 (set! dot-list (cons* (cdr my-item) dot-list))))
200 (parse-item (cdr mylist)))))
201 ;; calculate fret-range
203 (minfret (if (> capo-fret 0) capo-fret 99)))
204 (let updatemax ((fret-list dot-list)) ;CHANGE THIS TO HELPER FUNCTION?
205 (if (null? fret-list)
207 (let ((fretval (second (car fret-list))))
208 (if (> fretval maxfret) (set! maxfret fretval))
209 (if (< fretval minfret) (set! minfret fretval))
210 (updatemax (cdr fret-list)))))
211 (if (> maxfret my-fret-count)
214 (let ((upfret (- (+ minfret my-fret-count) 1)))
215 (if (> maxfret upfret) maxfret upfret)))))
216 (set! capo-fret (1+ (- capo-fret minfret)))
217 ; subtract fret from dots
218 (set! dot-list (subtract-base-fret (- (car fret-range) 1) dot-list)))
219 (acons 'fret-range fret-range
220 (acons 'barre-list barre-list
221 (acons 'dot-list dot-list
222 (acons 'xo-list xo-list
223 (acons 'capo-fret capo-fret '())))))))
225 (define (make-fret-diagram layout props marking-list)
226 "Make a fret diagram markup"
228 ; note: here we get items from props that are needed in this routine,
229 ; or that are needed in more than one of the procedures
230 ; called from this routine. If they're only used in one of the
231 ; sub-procedure, they're obtained in that procedure
232 (size (chain-assoc-get 'size props 1.0)) ; needed for everything
233 ;TODO -- get string-count directly from length of stringTunings;
234 ; from FretBoard engraver, but not from markup call
235 (details (merge-details 'fret-diagram-details props '()))
237 (assoc-get 'string-count details 6)) ; needed for everything
239 (assoc-get 'fret-count details 4)) ; needed for everything
241 (assoc-get 'orientation details 'normal)) ; needed for everything
244 'finger-code details 'none)) ; needed for draw-dots and draw-barre
246 (if (eq? finger-code 'in-dot) 0.425 0.25)) ; bigger dots if labeled
247 (default-dot-position
248 (if (eq? finger-code 'in-dot)
249 (- 0.95 default-dot-radius)
250 0.6)) ; move up to make room for bigger dot if labeled
253 'dot-radius details default-dot-radius)) ; needed for draw-dots
257 'dot-position details default-dot-position)) ; needed for
258 ; draw-dots and draw-barre
260 (* (ly:output-def-lookup layout 'line-thickness)
261 (chain-assoc-get 'thickness props 0.5))) ; needed for draw-frets
264 (thickness-factor (assoc-get 'string-thickness-factor details 0))
266 (chain-assoc-get 'align-dir props -0.4)) ; needed only here
268 (* size (assoc-get 'xo-padding details 0.2))) ; needed only here
269 (parameters (fret-parse-marking-list marking-list my-fret-count))
270 (capo-fret (assoc-get 'capo-fret parameters 0))
271 (dot-list (assoc-get 'dot-list parameters))
272 (xo-list (assoc-get 'xo-list parameters))
273 (fret-range (assoc-get 'fret-range parameters))
274 (my-fret-count (fret-count fret-range))
275 (barre-list (assoc-get 'barre-list parameters))
277 (assoc-get 'barre-type details 'curved))
278 (fret-diagram-stencil '()))
280 ;; Here are the fret diagram helper functions that depend on the
281 ;; fret diagram parameters. The functions are here because the
282 ;; diagram parameters are part of the lexical scope here.
284 (define (stencil-coordinates fret-coordinate string-coordinate)
285 "Return a pair @code{(x-coordinate . y-coordinate)}
286 in stencil coordinate system."
288 ((eq? orientation 'landscape)
289 (cons fret-coordinate
290 (- string-coordinate (1- string-count))))
291 ((eq? orientation 'opposing-landscape)
292 (cons (- fret-coordinate) (- string-coordinate)))
294 (cons string-coordinate (- fret-coordinate)))))
296 (define (stencil-coordinate-offset fret-offset string-offset)
297 "Return a pair @code{(x-offset . y-offset)}
298 for translation in stencil coordinate system."
300 ((eq? orientation 'landscape)
301 (cons fret-offset (- string-offset)))
302 ((eq? orientation 'opposing-landscape)
303 (cons (- fret-offset) string-offset))
305 (cons string-offset (- fret-offset)))))
309 (define (make-bezier-sandwich-list start stop base height
311 "Make the argument list for a bezier sandwich from
312 string coordinate @var{start} to string-coordinate @var{stop} with a
313 baseline at fret coordinate @var{base}, a height of
314 @var{height}, and a half thickness of @var{half-thickness}."
315 (let* ((width (+ (- stop start) 1))
316 (cp-left-width (+ (* width half-thickness) start))
317 (cp-right-width (- stop (* width half-thickness)))
318 (bottom-control-point-height
319 (- base (- height half-thickness)))
320 (top-control-point-height
323 (stencil-coordinates base start))
325 (stencil-coordinates base stop))
326 (left-upper-control-point
328 top-control-point-height cp-left-width))
329 (left-lower-control-point
331 bottom-control-point-height cp-left-width))
332 (right-upper-control-point
334 top-control-point-height cp-right-width))
335 (right-lower-control-point
337 bottom-control-point-height cp-right-width)))
338 ; order of bezier control points is:
339 ; left cp low, right cp low, right end low, left end low
340 ; right cp high, left cp high, left end high, right end high.
342 (list left-lower-control-point
343 right-lower-control-point
346 right-upper-control-point
347 left-upper-control-point
351 (define (draw-strings)
352 "Draw the string lines for a fret diagram with
353 @var{string-count} strings and frets as indicated in @var{fret-range}.
354 Line thickness is given by @var{th}, fret & string spacing by
355 @var{size}. Orientation is determined by @var{orientation}. "
359 (string-stencil (car x))
361 (string-stencil (car x))
364 (let* ( (string-list (map 1+ (iota string-count))))
365 (helper string-list)))
367 (define (string-stencil string)
368 "Make a stencil for @code{string}, given the fret-diagram
370 (let* ((string-coordinate (- string-count string))
371 (current-string-thickness
372 (* th size (string-thickness string thickness-factor)))
373 (fret-half-thickness (* size th 0.5))
374 (half-string (* current-string-thickness 0.5))
377 (- fret-half-thickness)
378 (- (* size string-coordinate) half-string)))
381 (+ fret-half-thickness (* size (1+ (fret-count fret-range))))
382 (+ half-string (* size string-coordinate)))))
384 (string-x-extent start-coordinates end-coordinates)
385 (string-y-extent start-coordinates end-coordinates)
389 "Draw the fret lines for a fret diagram with
390 @var{string-count} strings and frets as indicated in @var{fret-range}.
391 Line thickness is given by @var{th}, fret & string spacing by
392 @var{size}. Orientation is given by @var{orientation}."
395 (fret-stencil (car x))
397 (fret-stencil (car x))
400 (let ((fret-list (iota (1+ my-fret-count))))
403 (define (fret-stencil fret)
404 "Make a stencil for @code{fret}, given the
405 fret-diagram overall parameters."
406 (let* ((low-string-half-thickness
410 (string-thickness string-count thickness-factor)))
411 (fret-half-thickness (* 0.5 size th))
415 (- fret-half-thickness low-string-half-thickness)))
419 (* size (1- string-count)))))
422 (car start-coordinates) (cdr start-coordinates)
423 (car end-coordinates) (cdr end-coordinates))))
425 (define (draw-barre barre-list)
426 "Create barre indications for a fret diagram"
427 (if (not (null? barre-list))
428 (let* ((string1 (caar barre-list))
429 (string2 (cadar barre-list))
430 (barre-fret (caddar barre-list))
431 (top-fret (cdr fret-range))
432 (low-fret (car fret-range))
433 (fret (1+ (- barre-fret low-fret)))
434 (barre-vertical-offset 0.5)
435 (dot-center-fret-coordinate (+ (1- fret) dot-position))
436 (barre-fret-coordinate
437 (+ dot-center-fret-coordinate
438 (* (- barre-vertical-offset 0.5) dot-radius)))
439 (barre-start-string-coordinate (- string-count string1))
440 (barre-end-string-coordinate (- string-count string2))
441 (scale-dot-radius (* size dot-radius))
442 (barre-type (assoc-get 'barre-type details 'curved))
445 ((eq? barre-type 'straight)
446 (make-straight-barre-stencil
447 barre-fret-coordinate
448 barre-start-string-coordinate
449 barre-end-string-coordinate
451 ((eq? barre-type 'curved)
452 (make-curved-barre-stencil
453 barre-fret-coordinate
454 barre-start-string-coordinate
455 barre-end-string-coordinate
456 scale-dot-radius)))))
457 (if (not (null? (cdr barre-list)))
460 (draw-barre (cdr barre-list)))
463 (define (make-straight-barre-stencil
465 start-string-coordinate
466 end-string-coordinate
468 "Create a straight barre stencil."
471 (* size fret-coordinate)
472 (* size start-string-coordinate)))
475 (* size fret-coordinate)
476 (* size end-string-coordinate))))
484 (define (make-curved-barre-stencil
486 start-string-coordinate
487 end-string-coordinate
489 "Create a curved barre stencil."
490 (let* ((bezier-thick 0.1)
493 (make-bezier-sandwich-list
494 (* size start-string-coordinate)
495 (* size end-string-coordinate)
496 (* size fret-coordinate)
497 (* size bezier-height)
498 (* size bezier-thick)))
501 (+ (* size fret-coordinate) half-thickness)
502 (- (* size start-string-coordinate) half-thickness)))
505 (- (* size fret-coordinate)
506 (* size bezier-height)
508 (+ (* size end-string-coordinate) half-thickness)))
509 (x-extent (cons (car box-lower-left) (car box-upper-right)))
510 (y-extent (cons (cdr box-lower-left) (cdr box-upper-right))))
512 (list 'bezier-sandwich
513 `(quote ,bezier-list)
514 (* size bezier-thick))
518 (define (draw-dots dot-list)
519 "Make dots for fret diagram."
521 (let* ( (scale-dot-radius (* size dot-radius))
522 (scale-dot-thick (* size th))
523 (dot-color (assoc-get 'dot-color details 'black))
524 (finger-label-padding 0.3)
527 (assoc-get 'dot-label-font-mag details 1.0)))
528 (string-label-font-mag
531 'string-label-font-mag details
532 (cond ((or (eq? orientation 'landscape)
533 (eq? orientation 'opposing-landscape))
536 (mypair (car dot-list))
537 (restlist (cdr dot-list))
538 (string (car mypair))
540 (fret-coordinate (* size (+ (1- fret) dot-position)))
541 (string-coordinate (* size (- string-count string)))
543 (stencil-coordinates fret-coordinate string-coordinate))
544 (extent (cons (- scale-dot-radius) scale-dot-radius))
545 (finger (caddr mypair))
546 (finger (if (number? finger) (number->string finger) finger))
547 (dot-stencil (if (eq? dot-color 'white)
550 scale-dot-radius scale-dot-thick #t)
553 (- scale-dot-radius (* 0.5 scale-dot-thick))
557 scale-dot-radius scale-dot-thick #t)))
559 (ly:stencil-translate dot-stencil dot-coordinates))
562 ((or (eq? finger '())(eq? finger-code 'none))
564 ((eq? finger-code 'in-dot)
568 layout props dot-label-font-mag finger))))
569 (ly:stencil-translate
572 (if (eq? dot-color 'white)
574 (ly:stencil-in-color finger-label 1 1 1)))
576 ((eq? finger-code 'below-string)
577 (let* ((label-stencil
580 layout props string-label-font-mag
583 (stencil-fretboard-offset
584 label-stencil 'fret orientation))
585 (label-fret-coordinate
587 (+ 1 my-fret-count finger-label-padding))
589 (label-string-coordinate string-coordinate)
592 label-fret-coordinate
593 label-string-coordinate)))
596 (ly:stencil-translate
598 label-translation))))
599 (else ;unknown finger-code
605 labeled-dot-stencil))))
607 (define (draw-thick-zero-fret)
608 "Draw a thick zeroth fret for a fret diagram whose base fret is 1."
609 (let* ((half-lowest-string-thickness
610 (* 0.5 th (string-thickness string-count thickness-factor)))
611 (half-thick (* 0.5 sth))
613 (* sth (assoc-get 'top-fret-thickness details 3.0)))
614 (start-string-coordinate (- half-lowest-string-thickness))
615 (end-string-coordinate (+ (* size (1- string-count)) half-thick))
616 (start-fret-coordinate half-thick)
617 (end-fret-coordinate (- half-thick top-fret-thick))
620 start-fret-coordinate start-string-coordinate))
623 end-fret-coordinate end-string-coordinate)))
625 (cons (car lower-left) (car upper-right))
626 (cons (cdr lower-left) (cdr upper-right))
629 (define (draw-xo xo-list)
630 "Put open and mute string indications on diagram, as contained in
634 'xo-font-magnification details
635 (cond ((or (eq? orientation 'landscape)
636 (eq? orientation 'opposing-landscape))
639 (mypair (car xo-list))
640 (restlist (cdr xo-list))
641 (glyph-string (if (eq? (car mypair) 'mute)
642 (assoc-get 'mute-string details "X")
643 (assoc-get 'open-string details "O")))
644 (glyph-string-coordinate (* (- string-count (cadr mypair)) size))
648 layout props (* size xo-font-mag) glyph-string)))
649 (glyph-stencil-coordinates
650 (stencil-coordinates 0 glyph-string-coordinate))
652 (ly:stencil-translate
654 glyph-stencil-coordinates)))
659 (draw-xo restlist)))))
661 (define (draw-capo fret)
662 "Draw a capo indicator across the full width of the fret-board
665 (* size (assoc-get 'capo-thickness details 0.5)))
666 (half-thick (* capo-thick 0.5))
667 (last-string-position 0)
668 (first-string-position (* size (- string-count 1)))
669 (fret-position ( * size (1- (+ dot-position fret))))
673 first-string-position))
677 last-string-position)))
680 (car start-point) (cdr start-point)
681 (car end-point) (cdr end-point))))
683 (define (label-fret fret-range)
684 "Label the base fret on a fret diagram"
685 (let* ((base-fret (car fret-range))
686 (label-font-mag (assoc-get 'fret-label-font-mag details 0.5))
687 (label-space (* 0.5 size))
688 (label-dir (assoc-get 'label-dir details RIGHT))
689 (label-vertical-offset
690 (assoc-get 'fret-label-vertical-offset details 0))
692 (assoc-get 'number-type details 'roman-lower))
695 ((equal? number-type 'roman-lower)
696 (fancy-format #f "~(~@r~)" base-fret))
697 ((equal? number-type 'roman-upper)
698 (fancy-format #f "~@r" base-fret))
699 ((equal? 'arabic number-type)
700 (fancy-format #f "~d" base-fret))
701 (else (fancy-format #f "~(~@r~)" base-fret))))
705 layout props (* size label-font-mag) label-text)))
707 (stencil-fretboard-offset
711 (label-outside-diagram (+ label-space label-half-width)))
712 (ly:stencil-translate
715 (1+ (* size label-vertical-offset))
716 (if (eq? label-dir LEFT)
717 (- label-outside-diagram)
718 (+ (* size (1- string-count)) label-outside-diagram))))))
721 ; Here is the body of make-fret-diagram
724 (set! fret-diagram-stencil
725 (ly:stencil-add (draw-strings) (draw-frets)))
726 (if (and (not (null? barre-list))
727 (not (eq? 'none barre-type)))
728 (set! fret-diagram-stencil
730 (draw-barre barre-list)
731 fret-diagram-stencil)))
732 (if (not (null? dot-list))
733 (set! fret-diagram-stencil
736 (draw-dots dot-list))))
737 (if (= (car fret-range) 1)
738 (set! fret-diagram-stencil
741 (draw-thick-zero-fret))))
742 (if (not (null? xo-list))
743 (let* ((diagram-fret-top
744 (car (stencil-fretboard-extent
748 (xo-stencil (draw-xo xo-list))
750 (stencil-fretboard-offset
751 xo-stencil 'fret orientation))
753 (stencil-coordinate-offset
758 (set! fret-diagram-stencil
761 (ly:stencil-translate
763 xo-stencil-offset)))))
765 (set! fret-diagram-stencil
768 (draw-capo capo-fret))))
769 (if (> (car fret-range) 1)
770 (set! fret-diagram-stencil
773 (label-fret fret-range))))
774 (ly:stencil-aligned-to fret-diagram-stencil X alignment)))
776 (define (fret-parse-definition-string props definition-string)
777 "Parse a fret diagram string and return a pair containing:
778 @var{props}, modified as necessary by the definition-string
779 a fret-indication list with the appropriate values"
780 (let* ((fret-count 4)
782 (fret-range (cons 1 fret-count))
788 (details (merge-details 'fret-diagram-details props '()))
789 (items (string-split definition-string #\;)))
790 (let parse-item ((myitems items))
791 (if (not (null? (cdr myitems)))
792 (let ((test-string (car myitems)))
793 (case (car (string->list (substring test-string 0 1)))
794 ((#\s) (let ((size (get-numeric-from-key test-string)))
795 (set! props (prepend-alist-chain 'size size props))))
796 ((#\f) (let* ((finger-code (get-numeric-from-key test-string))
797 (finger-id (case finger-code
800 ((2) 'below-string))))
802 (acons 'finger-code finger-id details))))
803 ((#\c) (set! output-list
808 (string-split (substring test-string 2) #\-)))
810 ((#\h) (let ((fret-count (get-numeric-from-key test-string)))
812 (acons 'fret-count fret-count details))))
813 ((#\w) (let ((string-count (get-numeric-from-key test-string)))
815 (acons 'string-count string-count details))))
816 ((#\d) (let ((dot-size (get-numeric-from-key test-string)))
818 (acons 'dot-radius dot-size details))))
819 ((#\p) (let ((dot-position (get-numeric-from-key test-string)))
821 (acons 'dot-position dot-position details))))
823 (let ((this-list (string-split test-string #\-)))
824 (if (string->number (cadr this-list))
827 (cons 'place-fret (numerify this-list))
829 (if (equal? (cadr this-list) "x" )
832 (list 'mute (string->number (car this-list)))
836 (list 'open (string->number (car this-list)))
838 (parse-item (cdr myitems)))))
839 ; add the modified details
841 (prepend-alist-chain 'fret-diagram-details details props))
842 `(,props . ,output-list))) ;ugh -- hard-coded spell -- procedure better
845 (fret-parse-terse-definition-string props definition-string)
846 "Parse a fret diagram string that uses terse syntax;
847 return a pair containing:
848 @var{props}, modified to include the string-count determined by the
849 definition-string, and
850 a fret-indication list with the appropriate values"
851 ;TODO -- change syntax to fret\string-finger
853 (let* ((details (merge-details 'fret-diagram-details props '()))
854 (barre-start-list '())
857 (items (string-split definition-string #\;))
858 (string-count (- (length items) 1)))
859 (let parse-item ((myitems items))
860 (if (not (null? (cdr myitems)))
861 (let* ((test-string (car myitems))
862 (current-string (- (length myitems) 1))
863 (indicators (string-split test-string #\ )))
864 (let parse-indicators ((myindicators indicators))
865 (if (not (eq? '() myindicators))
866 (let* ((this-list (string-split (car myindicators) #\-))
867 (max-element-index (- (length this-list) 1))
869 (car (list-tail this-list max-element-index)))
871 (if (string->number (car this-list))
872 (string->number (car this-list))
874 (if (equal? last-element "(")
876 (set! barre-start-list
877 (cons-fret (list current-string fret)
880 (list-head this-list max-element-index))))
881 (if (equal? last-element ")")
883 (get-sub-list fret barre-start-list))
884 (insert-index (- (length this-barre) 1)))
886 (cons-fret (cons* 'barre
892 (list-head this-list max-element-index))))
899 (drop-paren (numerify this-list)))
901 (if (equal? (car this-list) "x" )
905 (list 'mute current-string)
910 (list 'open current-string)
912 (parse-indicators (cdr myindicators)))))
913 (parse-item (cdr myitems)))))
914 (set! details (acons 'string-count string-count details))
915 (set! props (prepend-alist-chain 'fret-diagram-details details props))
916 `(,props . ,output-list))) ; ugh -- hard coded; proc is better
919 (define-builtin-markup-command
920 (fret-diagram-verbose layout props marking-list)
921 (pair?) ; argument type (list, but use pair? for speed)
922 instrument-specific-markup ; markup type
923 ((align-dir -0.4) ; properties and defaults
925 (fret-diagram-details)
927 "Make a fret diagram containing the symbols indicated in @var{marking-list}.
932 \\markup \\fret-diagram-verbose
933 #'((mute 6) (mute 5) (open 4)
934 (place-fret 3 2) (place-fret 2 3) (place-fret 1 2))
938 produces a standard D@tie{}chord diagram without fingering indications.
940 Possible elements in @var{marking-list}:
943 @item (mute @var{string-number})
944 Place a small @q{x} at the top of string @var{string-number}.
946 @item (open @var{string-number})
947 Place a small @q{o} at the top of string @var{string-number}.
949 @item (barre @var{start-string} @var{end-string} @var{fret-number})
950 Place a barre indicator (much like a tie) from string @var{start-string}
951 to string @var{end-string} at fret @var{fret-number}.
953 @item (capo @var{fret-number})
954 Place a capo indicator (a large solid bar) across the entire fretboard
955 at fret location @var{fret-number}. Also, set fret @var{fret-number}
956 to be the lowest fret on the fret diagram.
958 @item (place-fret @var{string-number} @var{fret-number} @var{finger-value})
959 Place a fret playing indication on string @var{string-number} at fret
960 @var{fret-number} with an optional fingering label @var{finger-value}.
961 By default, the fret playing indicator is a solid dot. This can be
962 changed by setting the value of the variable @var{dot-color}. If the
963 @var{finger} part of the @code{place-fret} element is present,
964 @var{finger-value} will be displayed according to the setting of the
965 variable @var{finger-code}. There is no limit to the number of fret
966 indications per string.
969 (make-fret-diagram layout props marking-list))
972 (define-builtin-markup-command (fret-diagram layout props definition-string)
973 (string?) ; argument type
974 instrument-specific-markup ; markup category
975 (fret-diagram-verbose-markup) ; properties and defaults
976 "Make a (guitar) fret diagram. For example, say
979 \\markup \\fret-diagram #\"s:0.75;6-x;5-x;4-o;3-2;2-3;1-2;\"
983 for fret spacing 3/4 of staff space, D chord diagram
985 Syntax rules for @var{definition-string}:
989 Diagram items are separated by semicolons.
996 @code{s:}@var{number} -- Set the fret spacing of the diagram (in staff
1001 @code{t:}@var{number} -- Set the line thickness (in staff spaces).
1005 @code{h:}@var{number} -- Set the height of the diagram in frets.
1009 @code{w:}@var{number} -- Set the width of the diagram in strings.
1013 @code{f:}@var{number} -- Set fingering label type
1014 (0@tie{}= none, 1@tie{}= in circle on string, 2@tie{}= below string).
1018 @code{d:}@var{number} -- Set radius of dot, in terms of fret spacing.
1022 @code{p:}@var{number} -- Set the position of the dot in the fret space.
1023 0.5 is centered; 1@tie{}is on lower fret bar, 0@tie{}is on upper fret bar.
1027 @code{c:}@var{string1}@code{-}@var{string2}@code{-}@var{fret} -- Include a
1028 barre mark from @var{string1} to @var{string2} on @var{fret}.
1031 @var{string}@code{-}@var{fret} -- Place a dot on @var{string} at @var{fret}.
1032 If @var{fret} is @samp{o}, @var{string} is identified as open.
1033 If @var{fret} is @samp{x}, @var{string} is identified as muted.
1036 @var{string}@code{-}@var{fret}@code{-}@var{fingering} -- Place a dot on
1037 @var{string} at @var{fret}, and label with @var{fingering} as defined
1038 by the @code{f:} code.
1042 Note: There is no limit to the number of fret indications per string.
1044 (let ((definition-list
1045 (fret-parse-definition-string props definition-string)))
1046 (fret-diagram-verbose-markup
1047 layout (car definition-list) (cdr definition-list))))
1049 (define-builtin-markup-command
1050 (fret-diagram-terse layout props definition-string)
1051 (string?) ; argument type
1052 instrument-specific-markup ; markup category
1053 (fret-diagram-verbose-markup) ; properties
1054 "Make a fret diagram markup using terse string-based syntax.
1059 \\markup \\fret-diagram-terse #\"x;x;o;2;3;2;\"
1063 for a D@tie{}chord diagram.
1065 Syntax rules for @var{definition-string}:
1070 Strings are terminated by semicolons; the number of semicolons
1071 is the number of strings in the diagram.
1074 Mute strings are indicated by @samp{x}.
1077 Open strings are indicated by @samp{o}.
1080 A number indicates a fret indication at that fret.
1083 If there are multiple fret indicators desired on a string, they
1084 should be separated by spaces.
1087 Fingerings are given by following the fret number with a @code{-},
1088 followed by the finger indicator, e.g. @samp{3-2} for playing the third
1089 fret with the second finger.
1092 Where a barre indicator is desired, follow the fret (or fingering) symbol
1093 with @code{-(} to start a barre and @code{-)} to end the barre.
1096 ;; TODO -- change syntax to fret\string-finger
1097 (let ((definition-list
1098 (fret-parse-terse-definition-string props definition-string)))
1099 (fret-diagram-verbose-markup layout
1100 (car definition-list)
1101 (cdr definition-list))))