1 ;;;; fret-diagrams.scm --
3 ;;;; source file of the GNU LilyPond music typesetter
5 ;;;; (c) 2004--2008 Carl D. Sorensen <c_sorensen@byu.edu>
12 (define (cons-fret new-value old-list)
13 "Put together a fret-list in the format desired by parse-string"
14 (if (eq? old-list '())
16 (cons* new-value old-list)))
18 (define (get-numeric-from-key keystring)
19 "Get the numeric value from a key of the form k:val"
20 (string->number (substring keystring 2 (string-length keystring))))
22 (define (numerify mylist)
23 "Convert string values to numeric or character"
26 (let ((numeric-value (string->number (car mylist))))
28 (cons* numeric-value (numerify (cdr mylist)))
29 (cons* (car (string->list (car mylist)))
30 (numerify (cdr mylist)))))))
33 "Calculate the font step necessary to get a desired magnification"
34 (* 6 (/ (log mag) (log 2))))
36 (define (fret-count fret-range)
37 "Calculate the fret count for the diagram given the range of frets in the diagram."
38 (1+ (- (cdr fret-range) (car fret-range))))
40 (define (subtract-base-fret base-fret dot-list)
41 "Subtract @var{base-fret} from every fret in @var{dot-list}"
44 (let ((this-list (car dot-list)))
45 (cons* (list (car this-list) (- (second this-list) base-fret)
46 (if (null? (cddr this-list))
49 (subtract-base-fret base-fret (cdr dot-list))))))
51 (define (make-bezier-sandwich-list start stop base height
52 half-thickness orientation)
53 "Make the argument list for a bezier sandwich from
54 string coordinate @var{start} to string-coordinate @var{stop} with a
55 baseline at fret coordinate @var{base}, a height of
56 @var{height}, and a half thickness of @var{half-thickness}."
57 (let* ((width (+ (- stop start) 1))
58 (cp-left-width (+ (* width half-thickness) start))
59 (cp-right-width (- stop (* width half-thickness)))
60 (bottom-control-point-height
61 (- base (- height half-thickness)))
62 (top-control-point-height
65 (stencil-coordinates base start orientation))
67 (stencil-coordinates base stop orientation))
68 (left-upper-control-point
70 top-control-point-height cp-left-width orientation))
71 (left-lower-control-point
73 bottom-control-point-height cp-left-width orientation))
74 (right-upper-control-point
76 top-control-point-height cp-right-width orientation))
77 (right-lower-control-point
79 bottom-control-point-height cp-right-width orientation)))
80 ; order of bezier control points is:
81 ; left cp low, right cp low, right end low, left end low
82 ; right cp high, left cp high, left end high, right end high.
84 (list left-lower-control-point
85 right-lower-control-point
88 right-upper-control-point
89 left-upper-control-point
93 (define (drop-paren item-list)
94 "Drop a final parentheses from a fret indication list
95 @code{item-list} resulting from a terse string specification of barre."
96 (if (> (length item-list) 0)
97 (let* ((max-index (- (length item-list) 1))
98 (last-element (car (list-tail item-list max-index))))
99 (if (or (equal? last-element ")") (equal? last-element "("))
100 (list-head item-list max-index)
104 (define (get-sub-list value master-list)
105 "Get a sub-list whose cadr is equal to @var{value} from @var{master-list}"
106 (if (eq? master-list '())
108 (let ((sublist (car master-list)))
109 (if (equal? (cadr sublist) value)
111 (get-sub-list value (cdr master-list))))))
113 (define (merge-details key alist-list . default)
114 "Return @code{alist-list} entries for @code{key}, in one combined alist.
115 There can be two @code{alist-list} entries for a given key. The first
116 comes from the override-markup function, the second comes
117 from property settings during a regular override.
118 This is necessary because some details can be set in one
119 place, while others are set in the other. Both details
120 lists must be merged into a single alist.
121 Return @code{default} (optional, else #f) if not
124 (define (helper key alist-list default)
125 (if (null? alist-list)
127 (let* ((handle (assoc key (car alist-list))))
129 (append (cdr handle) (chain-assoc-get key (cdr alist-list) '()))
130 (helper key (cdr alist-list) default)))))
132 (helper key alist-list
133 (if (pair? default) (car default) #f)))
136 ; Conversions between fret/string coordinate system and x-y coordinate
139 ; Fret coordinates are measured down the fretboard from the nut,
142 ; String coordinates are measured from the lowest string, starting at 0.
144 ; The x-y origin is at the intersection of the nut and the lowest string.
146 ; X coordinates are positive to the right.
147 ; Y coordinates are positive up.
150 (define (negate-extent extent)
151 "Return the extent in an axis opposite to the axis of @code{extent}."
152 (cons (- (cdr extent)) (- (car extent))))
154 (define (stencil-fretboard-extent stencil fretboard-axis orientation)
155 "Return the extent of @code{stencil} in the @code{fretboard-axis}
157 (if (eq? fretboard-axis 'fret)
158 (cond ((eq? orientation 'landscape)
159 (ly:stencil-extent stencil X))
160 ((eq? orientation 'opposing-landscape)
161 (negate-extent (ly:stencil-extent stencil X)))
163 (negate-extent (ly:stencil-extent stencil Y))))
164 ; else -- eq? fretboard-axis 'string
165 (cond ((eq? orientation 'landscape)
166 (ly:stencil-extent stencil Y))
167 ((eq? orientation 'opposing-landscape)
168 (negate-extent (ly:stencil-extent stencil Y)))
170 (ly:stencil-extent stencil Y)))))
173 (define (stencil-fretboard-offset stencil fretboard-axis orientation)
174 "Return a the stencil coordinates of the center of @code{stencil}
175 in the @code{fretboard-axis} direction."
176 (* 0.5 (interval-length
177 (stencil-fretboard-extent stencil fretboard-axis orientation))))
179 (define (stencil-coordinates fret-coordinate string-coordinate orientation)
180 "Return a pair @code{(x-coordinate . y-coordinate)} in stencil coordinate
183 ((eq? orientation 'landscape)
184 (cons fret-coordinate string-coordinate))
185 ((eq? orientation 'opposing-landscape)
186 (cons (- fret-coordinate) (- string-coordinate)))
188 (cons string-coordinate (- fret-coordinate)))))
191 ; Functions that create stencils used in the fret diagram
194 (define (sans-serif-stencil layout props mag text)
195 "Create a stencil in sans-serif font based on @var{layout} and @var{props}
196 with magnification @var{mag} of the string @var{text}."
199 'font-size (stepmag mag)
200 (prepend-alist-chain 'font-family 'sans props))))
201 (interpret-markup layout my-props text)))
204 (define (string-stencil string string-count fret-range
205 th thickness-factor size orientation)
206 "Make a stencil for @code{string}, given the fret-diagram
208 (let* ((string-thickness (* th (expt (1+ thickness-factor) string)))
216 (* size (1+ (fret-count fret-range)))
221 (car start-coordinates) (cdr start-coordinates)
222 (car end-coordinates) (cdr end-coordinates))))
224 (define (fret-stencil fret fret-range string-count th size orientation)
225 "Make a stencil for @code{fret}, given the fret-diagram overall parameters."
226 (let* ((start-coordinates
234 (* size (1- string-count))
238 (car start-coordinates) (cdr start-coordinates)
239 (car end-coordinates) (cdr end-coordinates))))
241 (define (make-straight-barre-stencil
242 size half-thickness fret-coordinate
243 start-string-coordinate end-string-coordinate orientation)
244 "Create a straight barre stencil."
247 (* size fret-coordinate)
248 (* size start-string-coordinate)
252 (* size fret-coordinate)
253 (* size end-string-coordinate)
262 (define (make-curved-barre-stencil
263 size half-thickness fret-coordinate
264 start-string-coordinate end-string-coordinate orientation)
265 "Create a curved barre stencil."
266 (let* ((bezier-thick 0.1)
269 (make-bezier-sandwich-list
270 (* size start-string-coordinate)
271 (* size end-string-coordinate)
272 (* size fret-coordinate)
273 (* size bezier-height)
274 (* size bezier-thick)
278 (+ (* size fret-coordinate) half-thickness)
279 (- (* size start-string-coordinate) half-thickness)
283 (- (* size fret-coordinate) (* size bezier-height) half-thickness)
284 (+ (* size end-string-coordinate) half-thickness)
286 (x-extent (cons (car box-lower-left) (car box-upper-right)))
287 (y-extent (cons (cdr box-lower-left) (cdr box-upper-right))))
289 (list 'bezier-sandwich
290 `(quote ,bezier-list)
291 (* size bezier-thick))
298 ; Functions used to draw fret-diagram elements
302 (define (draw-strings string-count fret-range th
303 thickness-factor size orientation)
304 "Draw the string lines for a fret diagram with
305 @var{string-count} strings and frets as indicated in @var{fret-range}.
306 Line thickness is given by @var{th}, fret & string spacing by
307 @var{size}. Orientation is determined by @var{orientation}. "
312 (car x) string-count fret-range th
313 thickness-factor size orientation)
316 (car x) string-count fret-range th
317 thickness-factor size orientation)
320 (let* ( (string-list (map 1+ (iota string-count))))
321 (helper string-list)))
323 (define (draw-fret-lines fret-count string-count th size orientation)
324 "Draw @var{fret-count} fret lines for a fret diagram
325 with @var{string-count} strings. Line thickness is given by @var{th},
326 fret & string spacing by @var{size}. Orientation is given by @var{orientation}"
330 (car x) fret-count string-count th
334 (car x) fret-count string-count th
338 (let* ((fret-list (iota (1+ fret-count))))
341 (define (draw-thick-zero-fret details string-count th size orientation)
342 "Draw a thick zeroth fret for a fret diagram whose base fret is 1."
343 (let* ((sth (* th size))
344 (half-thick (* 0.5 sth))
346 (* sth (assoc-get 'top-fret-thickness details 3.0)))
347 (start-string-coordinate (- half-thick))
348 (end-string-coordinate (+ (* size (1- string-count)) half-thick))
349 (start-fret-coordinate half-thick)
350 (end-fret-coordinate (- half-thick top-fret-thick))
353 start-fret-coordinate start-string-coordinate orientation))
356 end-fret-coordinate end-string-coordinate orientation)))
357 (make-filled-box-stencil
358 (cons (car lower-left) (car upper-right))
359 (cons (cdr lower-left) (cdr upper-right)))))
362 (define (draw-capo details string-count fret fret-count th size
364 "Draw a capo indicator across the full width of the fret-board
366 (let* (;(sth (* th size))
368 (* size (assoc-get 'capo-thickness details 0.5)))
369 (half-thick (* capo-thick 0.5))
371 (first-string-pos (* size (- string-count 1)))
372 (fret-pos ( * size (1- (+ dot-pos fret))))
374 (stencil-coordinates fret-pos first-string-pos orientation))
376 (stencil-coordinates fret-pos last-string-pos orientation)))
379 (car start-point) (cdr start-point)
380 (car end-point) (cdr end-point))))
382 (define (draw-frets fret-range string-count th size orientation)
383 "Draw the fret lines for a fret diagram with
384 @var{string-count} strings and frets as indicated in @var{fret-range}.
385 Line thickness is given by @var{th}, fret & string spacing by
386 @var{size}. Orientation is given by @var{orientation}."
387 (let* ((my-fret-count (fret-count fret-range)))
388 (draw-fret-lines my-fret-count string-count th size orientation)))
390 (define (draw-dots layout props string-count fret-count
392 dot-position dot-radius dot-thickness dot-list orientation)
393 "Make dots for fret diagram."
395 (let* ((details (merge-details 'fret-diagram-details props '()))
396 (scale-dot-radius (* size dot-radius))
397 (scale-dot-thick (* size dot-thickness))
398 (dot-color (assoc-get 'dot-color details 'black))
399 (finger-label-padding 0.3)
401 (* scale-dot-radius (assoc-get 'dot-label-font-mag details 1.0)))
402 (string-label-font-mag
404 (assoc-get 'string-label-font-mag details
405 (cond ((or (eq? orientation 'landscape)
406 (eq? orientation 'opposing-landscape))
409 (mypair (car dot-list))
410 (restlist (cdr dot-list))
411 (string (car mypair))
413 (fret-coordinate (* size (+ (1- fret) dot-position)))
414 (string-coordinate (* size (- string-count string)))
416 (stencil-coordinates fret-coordinate string-coordinate orientation))
417 (extent (cons (- scale-dot-radius) scale-dot-radius))
418 (finger (caddr mypair))
419 (finger (if (number? finger) (number->string finger) finger))
420 (dot-stencil (if (eq? dot-color 'white)
423 scale-dot-radius scale-dot-thick #t)
426 (- scale-dot-radius (* 0.5 scale-dot-thick))
430 scale-dot-radius scale-dot-thick #t)))
431 (positioned-dot (translate-stencil dot-stencil dot-coordinates))
434 ((or (eq? finger '())(eq? finger-code 'none))
436 ((eq? finger-code 'in-dot)
440 layout props dot-label-font-mag finger))))
444 (if (eq? dot-color 'white)
446 (ly:stencil-in-color finger-label 1 1 1)))
448 ((eq? finger-code 'below-string)
449 (let* ((label-stencil
452 layout props string-label-font-mag
455 (stencil-fretboard-offset
456 label-stencil 'fret orientation))
457 (label-fret-coordinate
458 (+ (* size (+ 1 fret-count finger-label-padding))
460 (label-string-coordinate string-coordinate)
463 label-fret-coordinate
464 label-string-coordinate
468 (translate-stencil label-stencil label-translation))))
469 (else ;unknown finger-code
475 layout props string-count fret-count size finger-code
476 dot-position dot-radius dot-thickness restlist orientation)
477 labeled-dot-stencil))))
480 layout props string-count fret-range size xo-list orientation)
481 "Put open and mute string indications on diagram, as contained in
483 (let* ((details (merge-details 'fret-diagram-details props '()))
486 'xo-font-magnification details
487 (cond ((or (eq? orientation 'landscape)
488 (eq? orientation 'opposing-landscape))
491 (mypair (car xo-list))
492 (restlist (cdr xo-list))
493 (glyph-string (if (eq? (car mypair) 'mute)
494 (assoc-get 'mute-string details "X")
495 (assoc-get 'open-string details "O")))
496 (glyph-string-coordinate (* (- string-count (cadr mypair)) size))
500 layout props (* size xo-font-mag) glyph-string)))
501 (glyph-stencil-coordinates
502 (stencil-coordinates 0 glyph-string-coordinate orientation))
504 (translate-stencil glyph-stencil glyph-stencil-coordinates)))
509 layout props string-count fret-range size restlist orientation)
512 (define (draw-barre layout props string-count fret-range
513 size finger-code dot-position dot-radius
514 barre-list orientation)
515 "Create barre indications for a fret diagram"
516 (if (not (null? barre-list))
517 (let* ((details (merge-details 'fret-diagram-details props '()))
518 (string1 (caar barre-list))
519 (string2 (cadar barre-list))
520 (barre-fret (caddar barre-list))
521 (top-fret (cdr fret-range))
522 (low-fret (car fret-range))
523 (fret (1+ (- barre-fret low-fret)))
524 (barre-vertical-offset 0.5)
525 (dot-center-fret-coordinate (+ (1- fret) dot-position))
526 (barre-fret-coordinate
527 (+ dot-center-fret-coordinate
528 (* (- barre-vertical-offset 0.5) dot-radius)))
529 (barre-start-string-coordinate (- string-count string1))
530 (barre-end-string-coordinate (- string-count string2))
531 (scale-dot-radius (* size dot-radius))
532 (barre-type (assoc-get 'barre-type details 'curved))
535 ((eq? barre-type 'straight)
536 (make-straight-barre-stencil size scale-dot-radius
537 barre-fret-coordinate barre-start-string-coordinate
538 barre-end-string-coordinate orientation))
539 ((eq? barre-type 'curved)
540 (make-curved-barre-stencil size scale-dot-radius
541 barre-fret-coordinate barre-start-string-coordinate
542 barre-end-string-coordinate orientation)))))
543 (if (not (null? (cdr barre-list)))
546 (draw-barre layout props string-count fret-range size finger-code
547 dot-position dot-radius (cdr barre-list) orientation))
550 (define (label-fret layout props string-count fret-range size orientation)
551 "Label the base fret on a fret diagram"
552 (let* ((details (merge-details 'fret-diagram-details props '()))
553 (base-fret (car fret-range))
554 (label-font-mag (assoc-get 'fret-label-font-mag details 0.5))
555 (label-space (* 0.5 size))
556 (label-dir (assoc-get 'label-dir details RIGHT))
557 (label-vertical-offset
558 (assoc-get 'fret-label-vertical-offset details 0))
560 (assoc-get 'number-type details 'roman-lower))
563 ((equal? number-type 'roman-lower)
564 (fancy-format #f "~(~@r~)" base-fret))
565 ((equal? number-type 'roman-upper)
566 (fancy-format #f "~@r" base-fret))
567 ((equal? 'arabic number-type)
568 (fancy-format #f "~d" base-fret))
569 (else (fancy-format #f "~(~@r~)" base-fret))))
573 layout props (* size label-font-mag) label-text)))
575 (stencil-fretboard-offset label-stencil 'string orientation))
576 (label-outside-diagram (+ label-space label-half-width)))
580 (1+ (* size label-vertical-offset))
581 (if (eq? label-dir LEFT)
582 (- label-outside-diagram)
583 (+ (* size (1- string-count)) label-outside-diagram))
588 ;; markup commands and associated functions
593 (define (fret-parse-marking-list marking-list my-fret-count)
594 "Parse a fret-diagram-verbose marking list into component sublists"
595 (let* ((fret-range (cons 1 my-fret-count))
601 (let parse-item ((mylist marking-list))
602 (if (not (null? mylist))
603 (let* ((my-item (car mylist)) (my-code (car my-item)))
605 ((or (eq? my-code 'open)(eq? my-code 'mute))
606 (set! xo-list (cons* my-item xo-list)))
607 ((eq? my-code 'barre)
608 (set! barre-list (cons* (cdr my-item) barre-list)))
610 (set! capo-fret (cadr my-item)))
611 ((eq? my-code 'place-fret)
612 (set! dot-list (cons* (cdr my-item) dot-list))))
613 (parse-item (cdr mylist)))))
614 ;; calculate fret-range
616 (minfret (if (> capo-fret 0) capo-fret 99)))
617 (let updatemax ((fret-list dot-list)) ;CHANGE THIS TO HELPER FUNCTION?
618 (if (null? fret-list)
620 (let ((fretval (second (car fret-list))))
621 (if (> fretval maxfret) (set! maxfret fretval))
622 (if (< fretval minfret) (set! minfret fretval))
623 (updatemax (cdr fret-list)))))
624 (if (> maxfret my-fret-count)
627 (let ((upfret (- (+ minfret my-fret-count) 1)))
628 (if (> maxfret upfret) maxfret upfret)))))
629 (set! capo-fret (1+ (- capo-fret minfret)))
630 ; subtract fret from dots
631 (set! dot-list (subtract-base-fret (- (car fret-range) 1) dot-list)))
632 (acons 'fret-range fret-range
633 (acons 'barre-list barre-list
634 (acons 'dot-list dot-list
635 (acons 'xo-list xo-list
636 (acons 'capo-fret capo-fret '())))))))
638 (define (make-fret-diagram layout props marking-list)
639 "Make a fret diagram markup"
641 ; note: here we get items from props that are needed in this routine,
642 ; or that are needed in more than one of the procedures
643 ; called from this routine. If they're only used in one of the
644 ; sub-procedure, they're obtained in that procedure
645 (size (chain-assoc-get 'size props 1.0)) ; needed for everything
646 ;TODO -- get string-count directly from length of stringTunings;
647 ; from FretBoard engraver, but not from markup call
648 (details (merge-details 'fret-diagram-details props '()))
650 (assoc-get 'string-count details 6)) ; needed for everything
652 (assoc-get 'fret-count details 4)) ; needed for everything
654 (assoc-get 'orientation details 'normal)) ; needed for everything
657 'finger-code details 'none)) ; needed for draw-dots and draw-barre
659 (if (eq? finger-code 'in-dot) 0.425 0.25)) ; bigger dots if labeled
660 (default-dot-position
661 (if (eq? finger-code 'in-dot)
662 (- 0.95 default-dot-radius)
663 0.6)) ; move up to make room for bigger if labeled
666 'dot-radius details default-dot-radius)) ; needed for draw-dots
670 'dot-position details default-dot-position)) ; needed for draw-dots
673 (* (ly:output-def-lookup layout 'line-thickness)
674 (chain-assoc-get 'thickness props 0.5))) ; needed for draw-frets
676 (thickness-factor (assoc-get 'string-thickness-factor details 0))
678 (chain-assoc-get 'align-dir props -0.4)) ; needed only here
680 (* size (assoc-get 'xo-padding details 0.2))) ; needed only here
681 (parameters (fret-parse-marking-list marking-list my-fret-count))
682 (capo-fret (assoc-get 'capo-fret parameters 0))
683 (dot-list (cdr (assoc 'dot-list parameters)))
684 (xo-list (cdr (assoc 'xo-list parameters)))
685 (fret-range (cdr (assoc 'fret-range parameters)))
686 (my-fret-count (fret-count fret-range))
687 (barre-list (cdr (assoc 'barre-list parameters)))
689 (assoc-get 'barre-type details 'curved))
690 (fret-diagram-stencil
693 string-count fret-range th thickness-factor size orientation)
694 (draw-frets fret-range string-count th size orientation))))
695 (if (and (not (null? barre-list))
696 (not (eq? 'none barre-type)))
697 (set! fret-diagram-stencil
699 (draw-barre layout props string-count fret-range size
700 finger-code dot-position dot-radius
701 barre-list orientation)
702 fret-diagram-stencil)))
703 (if (not (null? dot-list))
704 (set! fret-diagram-stencil
707 (draw-dots layout props string-count my-fret-count
708 size finger-code dot-position dot-radius
709 th dot-list orientation))))
710 (if (= (car fret-range) 1)
711 (set! fret-diagram-stencil
714 (draw-thick-zero-fret
715 details string-count th size orientation))))
716 (if (not (null? xo-list))
717 (let* ((diagram-fret-top
718 (car (stencil-fretboard-extent
723 (draw-xo layout props string-count fret-range
724 size xo-list orientation))
726 (stencil-fretboard-offset
727 xo-stencil 'fret orientation)))
728 (set! fret-diagram-stencil
741 (set! fret-diagram-stencil
744 (draw-capo details string-count capo-fret my-fret-count
745 th size dot-position orientation))))
746 (if (> (car fret-range) 1)
747 (set! fret-diagram-stencil
751 layout props string-count fret-range size orientation))))
752 (ly:stencil-aligned-to
753 (ly:stencil-aligned-to fret-diagram-stencil X alignment)
756 (define (fret-parse-definition-string props definition-string)
757 "Parse a fret diagram string and return a pair containing:
758 @var{props}, modified as necessary by the definition-string
759 a fret-indication list with the appropriate values"
760 (let* ((fret-count 4)
762 (fret-range (cons 1 fret-count))
768 (details (merge-details 'fret-diagram-details props '()))
769 (items (string-split definition-string #\;)))
770 (let parse-item ((myitems items))
771 (if (not (null? (cdr myitems)))
772 (let ((test-string (car myitems)))
773 (case (car (string->list (substring test-string 0 1)))
774 ((#\s) (let ((size (get-numeric-from-key test-string)))
775 (set! props (prepend-alist-chain 'size size props))))
776 ((#\f) (let* ((finger-code (get-numeric-from-key test-string))
777 (finger-id (case finger-code
780 ((2) 'below-string))))
782 (acons 'finger-code finger-id details))))
783 ((#\c) (set! output-list
788 (string-split (substring test-string 2) #\-)))
790 ((#\h) (let ((fret-count (get-numeric-from-key test-string)))
792 (acons 'fret-count fret-count details))))
793 ((#\w) (let ((string-count (get-numeric-from-key test-string)))
795 (acons 'string-count string-count details))))
796 ((#\d) (let ((dot-size (get-numeric-from-key test-string)))
798 (acons 'dot-radius dot-size details))))
799 ((#\p) (let ((dot-position (get-numeric-from-key test-string)))
801 (acons 'dot-position dot-position details))))
803 (let ((this-list (string-split test-string #\-)))
804 (if (string->number (cadr this-list))
807 (cons 'place-fret (numerify this-list))
809 (if (equal? (cadr this-list) "x" )
812 (list 'mute (string->number (car this-list)))
816 (list 'open (string->number (car this-list)))
818 (parse-item (cdr myitems)))))
819 ; add the modified details
821 (prepend-alist-chain 'fret-diagram-details details props))
822 `(,props . ,output-list))) ;ugh -- hard-coded spell -- procedure better
825 (fret-parse-terse-definition-string props definition-string)
826 "Parse a fret diagram string that uses terse syntax;
827 return a pair containing:
828 @var{props}, modified to include the string-count determined by the
829 definition-string, and
830 a fret-indication list with the appropriate values"
831 ;TODO -- change syntax to fret\string-finger
833 (let* ((details (merge-details 'fret-diagram-details props '()))
834 (barre-start-list '())
837 (items (string-split definition-string #\;))
838 (string-count (- (length items) 1)))
839 (let parse-item ((myitems items))
840 (if (not (null? (cdr myitems)))
841 (let* ((test-string (car myitems))
842 (current-string (- (length myitems) 1))
843 (indicators (string-split test-string #\ )))
844 (let parse-indicators ((myindicators indicators))
845 (if (not (eq? '() myindicators))
846 (let* ((this-list (string-split (car myindicators) #\-))
847 (max-element-index (- (length this-list) 1))
849 (car (list-tail this-list max-element-index)))
851 (if (string->number (car this-list))
852 (string->number (car this-list))
854 (if (equal? last-element "(")
856 (set! barre-start-list
857 (cons-fret (list current-string fret)
860 (list-head this-list max-element-index))))
861 (if (equal? last-element ")")
863 (get-sub-list fret barre-start-list))
864 (insert-index (- (length this-barre) 1)))
866 (cons-fret (cons* 'barre
872 (list-head this-list max-element-index))))
879 (drop-paren (numerify this-list)))
881 (if (equal? (car this-list) "x" )
885 (list 'mute current-string)
890 (list 'open current-string)
892 (parse-indicators (cdr myindicators)))))
893 (parse-item (cdr myitems)))))
894 (set! details (acons 'string-count string-count details))
895 (set! props (prepend-alist-chain 'fret-diagram-details details props))
896 `(,props . ,output-list))) ; ugh -- hard coded; proc is better
899 (define-builtin-markup-command
900 (fret-diagram-verbose layout props marking-list)
901 (pair?) ; argument type (list, but use pair? for speed)
902 instrument-specific-markup ; markup type
903 ((align-dir -0.4) ; properties and defaults
905 (fret-diagram-details)
907 "Make a fret diagram containing the symbols indicated in @var{marking-list}.
912 \\markup \\fret-diagram-verbose
913 #'((mute 6) (mute 5) (open 4)
914 (place-fret 3 2) (place-fret 2 3) (place-fret 1 2))
918 produces a standard D@tie{}chord diagram without fingering indications.
920 Possible elements in @var{marking-list}:
923 @item (mute @var{string-number})
924 Place a small @q{x} at the top of string @var{string-number}.
926 @item (open @var{string-number})
927 Place a small @q{o} at the top of string @var{string-number}.
929 @item (barre @var{start-string} @var{end-string} @var{fret-number})
930 Place a barre indicator (much like a tie) from string @var{start-string}
931 to string @var{end-string} at fret @var{fret-number}.
933 @item (capo @var{fret-number})
934 Place a capo indicator (a large solid bar) across the entire fretboard
935 at fret location @var{fret-number}. Also, set fret @var{fret-number}
936 to be the lowest fret on the fret diagram.
938 @item (place-fret @var{string-number} @var{fret-number} @var{finger-value})
939 Place a fret playing indication on string @var{string-number} at fret
940 @var{fret-number} with an optional fingering label @var{finger-value}.
941 By default, the fret playing indicator is a solid dot. This can be
942 changed by setting the value of the variable @var{dot-color}. If the
943 @var{finger} part of the @code{place-fret} element is present,
944 @var{finger-value} will be displayed according to the setting of the
945 variable @var{finger-code}. There is no limit to the number of fret
946 indications per string.
949 (make-fret-diagram layout props marking-list))
952 (define-builtin-markup-command (fret-diagram layout props definition-string)
953 (string?) ; argument type
954 instrument-specific-markup ; markup category
955 (fret-diagram-verbose-markup) ; properties and defaults
956 "Make a (guitar) fret diagram. For example, say
959 \\markup \\fret-diagram #\"s:0.75;6-x;5-x;4-o;3-2;2-3;1-2;\"
963 for fret spacing 3/4 of staff space, D chord diagram
965 Syntax rules for @var{definition-string}:
969 Diagram items are separated by semicolons.
976 @code{s:}@var{number} -- Set the fret spacing of the diagram (in staff
981 @code{t:}@var{number} -- Set the line thickness (in staff spaces).
985 @code{h:}@var{number} -- Set the height of the diagram in frets.
989 @code{w:}@var{number} -- Set the width of the diagram in strings.
993 @code{f:}@var{number} -- Set fingering label type
994 (0@tie{}= none, 1@tie{}= in circle on string, 2@tie{}= below string).
998 @code{d:}@var{number} -- Set radius of dot, in terms of fret spacing.
1002 @code{p:}@var{number} -- Set the position of the dot in the fret space.
1003 0.5 is centered; 1@tie{}is on lower fret bar, 0@tie{}is on upper fret bar.
1007 @code{c:}@var{string1}@code{-}@var{string2}@code{-}@var{fret} -- Include a
1008 barre mark from @var{string1} to @var{string2} on @var{fret}.
1011 @var{string}@code{-}@var{fret} -- Place a dot on @var{string} at @var{fret}.
1012 If @var{fret} is @samp{o}, @var{string} is identified as open.
1013 If @var{fret} is @samp{x}, @var{string} is identified as muted.
1016 @var{string}@code{-}@var{fret}@code{-}@var{fingering} -- Place a dot on
1017 @var{string} at @var{fret}, and label with @var{fingering} as defined
1018 by the @code{f:} code.
1022 Note: There is no limit to the number of fret indications per string.
1024 (let ((definition-list
1025 (fret-parse-definition-string props definition-string)))
1026 (fret-diagram-verbose-markup
1027 layout (car definition-list) (cdr definition-list))))
1029 (define-builtin-markup-command
1030 (fret-diagram-terse layout props definition-string)
1031 (string?) ; argument type
1032 instrument-specific-markup ; markup category
1033 (fret-diagram-verbose-markup) ; properties
1034 "Make a fret diagram markup using terse string-based syntax.
1039 \\markup \\fret-diagram-terse #\"x;x;o;2;3;2;\"
1043 for a D@tie{}chord diagram.
1045 Syntax rules for @var{definition-string}:
1050 Strings are terminated by semicolons; the number of semicolons
1051 is the number of strings in the diagram.
1054 Mute strings are indicated by @samp{x}.
1057 Open strings are indicated by @samp{o}.
1060 A number indicates a fret indication at that fret.
1063 If there are multiple fret indicators desired on a string, they
1064 should be separated by spaces.
1067 Fingerings are given by following the fret number with a @code{-},
1068 followed by the finger indicator, e.g. @samp{3-2} for playing the third
1069 fret with the second finger.
1072 Where a barre indicator is desired, follow the fret (or fingering) symbol
1073 with @code{-(} to start a barre and @code{-)} to end the barre.
1076 ;; TODO -- change syntax to fret\string-finger
1077 (let ((definition-list
1078 (fret-parse-terse-definition-string props definition-string)))
1079 (fret-diagram-verbose-markup layout
1080 (car definition-list)
1081 (cdr definition-list))))