- (ly:stencil-add
- (draw-dots paper props string-count fret-range size finger-code
- dot-position dot-radius restlist)
- labeled-dot-stencil))))
-
-(define (draw-xo paper props string-count fret-range size xo-list)
-"Put open and mute string indications on diagram, as contained in @var{xo-list}."
- (let* ((fret-count (+ (- (cadr fret-range) (car fret-range) 1)))
-; (xo-font-mag (* size (chain-assoc-get 'xo-font-magnification props 0.5)))
- (xo-font-mag (* size 0.5))
-; (xo-horizontal-offset (* size (chain-assoc-get 'xo-horizontal-offset props -0.35)))
- (xo-horizontal-offset (* size -0.35))
- (mypair (car xo-list))
- (restlist (cdr xo-list))
- (glyph-string (if (eq? (car mypair) 'mute) "X" "O"))
- (xpos (+ (* (- string-count (cadr mypair)) size) xo-horizontal-offset ))
- (glyph-stencil (ly:stencil-translate-axis
- (sans-serif-stencil paper props (* size xo-font-mag) glyph-string) xpos X)))
- (if (null? restlist)
- glyph-stencil
- (ly:stencil-add
- (draw-xo paper props string-count fret-range size restlist)
- glyph-stencil))))
-
-(define (make-bezier-sandwich-list left right bottom height thickness)
-" Make the argument list for a horizontal bezier sandwich from @var{left} to @var{right} with a bottom at @var{bottom},
- a height of @var{height}, and a thickness of @var{thickness}."
- (let* ((width (+ (- right left) 1))
- (x1 (+ (* width thickness) left))
- (x2 (- right (* width thickness)))
- (bottom-control-point-height (+ bottom (- height thickness)))
- (top-control-point-height (+ bottom height)))
- ; order of points is: left cp low, right cp low, right end low, left end low
- ; right cp high, left cp high, left end high, right end high.
- (list (cons x1 bottom-control-point-height) (cons x2 bottom-control-point-height) (cons right bottom) (cons left bottom)
- (cons x2 top-control-point-height) (cons x1 top-control-point-height) (cons left bottom) (cons right bottom))))
-
-(define (draw-barre paper props string-count fret-range size finger-code dot-position dot-radius barre-list)
- "Create barre indications for a fret diagram"
- (if (not (null? barre-list))
- (let* ((string1 (caar barre-list))
- (string2 (cadar barre-list))
- (fret (caddar barre-list))
- (barre-type (chain-assoc-get 'barre-type props 'curved))
- (scale-dot-radius (* size dot-radius))
- (barre-vertical-offset (chain-assoc-get 'barre-vertical-offset props 0.5))
- ; 2 is 1 for empty fret at bottom of figure + 1 for interval (top-fret - fret + 1) -- not an arbitrary constant
- (dot-center-y (* size (- (+ 2 (- (cadr fret-range) fret))dot-position) ))
- (bottom (+ dot-center-y (* barre-vertical-offset scale-dot-radius)))
- (left (* size (- string-count string1)))
- (right (* size (- string-count string2)))
-; (bezier-thick (chain-assoc-get 'bezier-thickness props 0.1))
- (bezier-thick 0.1)
-; (bezier-height (chain-assoc-get 'bezier-height props 0.5))
- (bezier-height 0.5)
- (bezier-list (make-bezier-sandwich-list left right bottom (* size bezier-height) (* size bezier-thick)))
- (barre-stencil (if (eq? barre-type 'straight)
- (ly:make-stencil (list 'draw-line (* size dot-radius) left dot-center-y right dot-center-y)
- (cons left right)
- (cons (- dot-center-y scale-dot-radius) (+ dot-center-y scale-dot-radius)))
- (ly:make-stencil (list 'bezier-sandwich `(quote ,bezier-list) (* size bezier-thick) )
- (cons left right)
- (cons bottom (+ bottom (* size bezier-height)))))))
+ (ly:stencil-add
+ (draw-dots
+ layout props string-count fret-count size finger-code
+ dot-position dot-radius dot-thickness restlist orientation)
+ labeled-dot-stencil))))
+
+(define (draw-xo layout props string-count fret-range size xo-list orientation)
+ "Put open and mute string indications on diagram, as contained in
+@var{xo-list}."
+ (let* ((details (chain-assoc-get 'fret-diagram-details props '()))
+ (fret-count (+ (- (cadr fret-range) (car fret-range) 1)))
+ (xo-font-mag
+ (* size (assoc-get 'xo-font-magnification details 0.5)))
+ (xo-horizontal-offset (* size -0.35))
+ (mypair (car xo-list))
+ (restlist (cdr xo-list))
+ (glyph-string (if (eq? (car mypair) 'mute)
+ (assoc-get 'mute-string details "X")
+ (assoc-get 'open-string details "O")))
+ (xpos
+ (+ (* (- string-count (cadr mypair)) size) xo-horizontal-offset ))
+ (glyph-stencil (if (eq? orientation 'normal)
+ (ly:stencil-translate-axis
+ (sans-serif-stencil
+ layout props (* size xo-font-mag) glyph-string)
+ xpos X)
+ (ly:stencil-translate-axis
+ (sans-serif-stencil
+ layout props (* size xo-font-mag) glyph-string)
+ xpos Y))))
+ (if (null? restlist)
+ glyph-stencil
+ (ly:stencil-add
+ (draw-xo
+ layout props string-count fret-range size restlist orientation)
+ glyph-stencil))))
+
+(define (make-bezier-sandwich-list start stop base height thickness orientation)
+ "Make the argument list for a bezier sandwich from
+@var{start} to @var{stop} with a baseline at @var{base}, a height of
+@var{height}, and a thickness of @var{thickness}. If @var{orientation} is
+@var{'normal}, @var{base} is a y coordinate, otherwise it's an x coordinate."
+ (let* ((width (+ (- stop start) 1))
+ (x1 (+ (* width thickness) start))
+ (x2 (- stop (* width thickness)))
+ (bottom-control-point-height
+ (if (eq? orientation 'normal)
+ (+ base (- height thickness))
+ (- base (- height thickness))))
+ (top-control-point-height
+ (if (eq? orientation 'normal)
+ (+ base height)
+ (- base height))))
+ ; order of bezier control points is:
+ ; left cp low, right cp low, right end low, left end low
+ ; right cp high, left cp high, left end high, right end high.
+ (if (eq? orientation 'normal)
+ (list (cons x1 bottom-control-point-height)
+ (cons x2 bottom-control-point-height)
+ (cons stop base)
+ (cons start base)
+ (cons x2 top-control-point-height)
+ (cons x1 top-control-point-height)
+ (cons start base)
+ (cons stop base))
+ (list (cons bottom-control-point-height x1)
+ (cons bottom-control-point-height x2)
+ (cons base stop)
+ (cons base start)
+ (cons top-control-point-height x2)
+ (cons top-control-point-height x1)
+ (cons base start)
+ (cons base stop)))))
+
+(define (draw-barre layout props string-count fret-range
+ size finger-code dot-position dot-radius
+ barre-list orientation)
+ "Create barre indications for a fret diagram"
+ (if (not (null? barre-list))
+ (let* ((details (chain-assoc-get 'fret-diagram-details props '()))
+ (string1 (caar barre-list))
+ (string2 (cadar barre-list))
+ (fret (caddar barre-list))
+ (top-fret (cadr fret-range))
+ (low-fret (car fret-range))
+ (barre-type (assoc-get 'barre-type details 'curved))
+ (scale-dot-radius (* size dot-radius))
+ (barre-vertical-offset 0.5)
+ ;; 2 is 1 for empty fret at bottom of figure + 1 for interval
+ ;; (top-fret - fret + 1) -- not an arbitrary constant
+ (dot-center-y
+ (* size (- (+ 2 (- (cadr fret-range) fret)) dot-position)))
+ (dot-center-fret-coordinate (+ (- fret low-fret) dot-position))
+ (barre-fret-coordinate
+ (+ dot-center-fret-coordinate
+ (* (- barre-vertical-offset 0.5) dot-radius)))
+ (barre-start-string-coordinate (- string-count string1))
+ (barre-end-string-coordinate (- string-count string2))
+ (bottom
+ (+ dot-center-y (* barre-vertical-offset scale-dot-radius)))
+ (left (* size (- string-count string1)))
+ (right (* size (- string-count string2)))
+ (bezier-thick 0.1)
+ (bezier-height 0.5)
+ (bezier-list
+ (if (eq? orientation 'normal)
+ (make-bezier-sandwich-list
+ (* size barre-start-string-coordinate)
+ (* size barre-end-string-coordinate)
+ (* size (+ 2 (- top-fret
+ (+ low-fret barre-fret-coordinate))))
+ (* size bezier-height)
+ (* size bezier-thick)
+ orientation)
+ (make-bezier-sandwich-list
+ (* size barre-start-string-coordinate)
+ (* size barre-end-string-coordinate)
+ (* size barre-fret-coordinate)
+ (* size bezier-height)
+ (* size bezier-thick)
+ orientation)))
+ (barre-stencil
+ (if (eq? barre-type 'straight)
+ (if (eq? orientation 'normal)
+ (make-line-stencil scale-dot-radius left dot-center-y
+ right dot-center-y)
+ (make-line-stencil scale-dot-radius
+ (* size barre-fret-coordinate)
+ (* size barre-start-string-coordinate)
+ (* size barre-fret-coordinate)
+ (* size barre-end-string-coordinate)))
+ (if (eq? orientation 'normal)
+ (ly:make-stencil
+ (list 'bezier-sandwich
+ `(quote ,bezier-list)
+ (* size bezier-thick))
+ (cons left right)
+ (cons bottom (+ bottom (* size bezier-height))))
+ (ly:make-stencil
+ (list 'bezier-sandwich
+ `(quote ,bezier-list)
+ (* size bezier-thick))
+ (cons bottom (+ bottom (* size bezier-height)))
+ (cons left right))))))