- (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 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* ((string1 (caar barre-list))
- (string2 (cadar barre-list))
- (fret (caddar barre-list))
- (top-fret (cadr fret-range))
- (low-fret (car fret-range))
- (barre-type (chain-assoc-get 'barre-type props 'curved))
- (scale-dot-radius (* size dot-radius))
- (barre-vertical-offset 0.5)
-; (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)))
- (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 (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 (if (eq? orientation 'normal)
- (make-bezier-sandwich-list
- (* size barre-start-string-coordinate)
- (* size barre-end-string-coordinate)
- (* size (+ 1 (- top-fret 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)
- (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 'draw-line (* size dot-radius)
- (* size barre-fret-coordinate)
- (* size barre-start-string-coordinate)
- (* size barre-fret-coordinate)
- (* size barre-end-string-coordinate))
- (cons (- (* size barre-fret-coordinate) scale-dot-radius)
- (+ (* size barre-fret-coordinate) scale-dot-radius))
- (cons (* size barre-start-string-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))))))
+ (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 (+ 1 (- top-fret 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)
+ (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 'draw-line (* size dot-radius)
+ (* size barre-fret-coordinate)
+ (* size barre-start-string-coordinate)
+ (* size barre-fret-coordinate)
+ (* size barre-end-string-coordinate))
+ (cons (- (* size barre-fret-coordinate)
+ scale-dot-radius)
+ (+ (* size barre-fret-coordinate)
+ scale-dot-radius))
+ (cons (* size barre-start-string-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))))))