X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Ffret-diagrams.scm;h=5e713e5d712258f89523db347471dda98e861d35;hb=9df981cba0f95e74df1cab06eacfccd467079928;hp=6537ece10c07d192dede7892980e65a902f7e934;hpb=488c76001aa0982eb7ccabdc3ee55ebb5a64a4bc;p=lilypond.git diff --git a/scm/fret-diagrams.scm b/scm/fret-diagrams.scm index 6537ece10c..5e713e5d71 100644 --- a/scm/fret-diagrams.scm +++ b/scm/fret-diagrams.scm @@ -2,7 +2,7 @@ ;;;; ;;;; source file of the GNU LilyPond music typesetter ;;;; -;;;; (c) 2004--2007 Carl D. Sorensen +;;;; (c) 2004--2008 Carl D. Sorensen (define (fret-parse-marking-list marking-list fret-count) (let* ((fret-range (list 1 fret-count)) @@ -70,18 +70,11 @@ Line thickness is given by @var{th}, fret & string spacing by (let* ((fret-count (+ (- (cadr fret-range) (car fret-range)) 1)) (sl (* (+ fret-count 1) size)) (sth (* size th)) - (half-thickness (* sth 0.5)) (gap (- size sth)) (string-stencil (if (eq? orientation 'normal) - (ly:make-stencil - (list 'draw-line sth 0 0 0 sl) - (cons (- half-thickness) half-thickness) - (cons (- half-thickness) (+ sl half-thickness))) - (ly:make-stencil - (list 'draw-line sth 0 0 sl 0) - (cons (- half-thickness) (+ sl half-thickness)) - (cons (- half-thickness) half-thickness))))) + (make-line-stencil sth 0 0 0 sl) + (make-line-stencil sth 0 0 sl 0)))) (if (= string-count 1) string-stencil (if (eq? orientation 'normal) @@ -125,16 +118,10 @@ fret & string spacing by @var{size}. Orientation is given by @var{orientation}" (sth (* size th)) (half-thickness (* sth 0.5))) (if (eq? orientation 'normal) - (ly:make-stencil - (list 'draw-line sth half-thickness size + (make-line-stencil sth half-thickness size (- fret-length half-thickness) size) - (cons 0 fret-length) - (cons (- half-thickness) half-thickness)) - (ly:make-stencil - (list 'draw-line sth 0 half-thickness - 0 (- fret-length half-thickness)) - (cons (- half-thickness) half-thickness) - (cons 0 fret-length))))) + (make-line-stencil sth 0 half-thickness + 0 (- fret-length half-thickness))))) (define (draw-thick-zero-fret details string-count th size orientation) "Draw a thick zeroth fret for a fret diagram whose base fret is not 1." @@ -176,7 +163,7 @@ Line thickness is given by @var{th}, fret & string spacing by (- size th))))) (define (draw-dots layout props string-count fret-count - fret-range size finger-code + size finger-code dot-position dot-radius dot-thickness dot-list orientation) "Make dots for fret diagram." @@ -259,7 +246,7 @@ Line thickness is given by @var{th}, fret & string spacing by labeled-dot-stencil (ly:stencil-add (draw-dots - layout props string-count fret-count fret-range size finger-code + layout props string-count fret-count size finger-code dot-position dot-radius dot-thickness restlist orientation) labeled-dot-stencil)))) @@ -366,7 +353,8 @@ Line thickness is given by @var{th}, fret & string spacing by (make-bezier-sandwich-list (* size barre-start-string-coordinate) (* size barre-end-string-coordinate) - (* size (+ 1 (- top-fret fret) barre-fret-coordinate)) + (* size (+ 2 (- top-fret + (+ low-fret barre-fret-coordinate)))) (* size bezier-height) (* size bezier-thick) orientation) @@ -380,25 +368,13 @@ Line thickness is given by @var{th}, fret & string spacing by (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) + (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)) - (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)))) + (* size barre-end-string-coordinate))) (if (eq? orientation 'normal) (ly:make-stencil (list 'bezier-sandwich @@ -435,12 +411,12 @@ Line thickness is given by @var{th}, fret & string spacing by (label-text (cond ((equal? number-type 'roman-lower) - (fancy-format #f "~(~:@r~)" base-fret)) + (fancy-format #f "~(~@r~)" base-fret)) ((equal? number-type 'roman-upper) - (fancy-format #f "~:@r" base-fret)) + (fancy-format #f "~@r" base-fret)) ((equal? 'arabic number-type) (fancy-format #f "~d" base-fret)) - (else (fancy-format #f "~(~:@r~)" base-fret))))) + (else (fancy-format #f "~(~@r~)" base-fret))))) (if (eq? orientation 'normal) (ly:stencil-translate-axis (sans-serif-stencil layout props (* size label-font-mag) label-text) @@ -451,7 +427,7 @@ Line thickness is given by @var{th}, fret & string spacing by (define-builtin-markup-command (fret-diagram-verbose layout props marking-list) (list?) ; argument type - fret-diagram ; markup type + instrument-specific-markup ; markup type ((align-dir -0.4) ; properties and defaults (size 1.0) (fret-diagram-details) @@ -546,12 +522,16 @@ indications per string. (dot-list (cdr (assoc 'dot-list parameters))) (xo-list (cdr (assoc 'xo-list parameters))) (fret-range (cdr (assoc 'fret-range parameters))) + (fret-count (1+ (- (cadr fret-range) (car fret-range)))) (barre-list (cdr (assoc 'barre-list parameters))) + (barre-type + (assoc-get 'barre-type details 'curved)) (fret-diagram-stencil (ly:stencil-add (draw-strings string-count fret-range th size orientation) (draw-frets fret-range string-count th size orientation)))) - (if (not (null? barre-list)) + (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 @@ -562,7 +542,7 @@ indications per string. (set! fret-diagram-stencil (ly:stencil-add fret-diagram-stencil - (draw-dots layout props string-count fret-count fret-range + (draw-dots layout props string-count fret-count size finger-code dot-position dot-radius th dot-list orientation)))) (if (= (car fret-range) 1) @@ -606,7 +586,7 @@ indications per string. (define-builtin-markup-command (fret-diagram layout props definition-string) (string?) ; argument type - fret-diagram ; markup category + instrument-specific-markup ; markup category (fret-diagram-verbose-markup) ; properties and defaults "Make a (guitar) fret diagram. For example, say @@ -772,7 +752,7 @@ Note: There is no limit to the number of fret indications per string. (define-builtin-markup-command (fret-diagram-terse layout props definition-string) (string?) ; argument type - fret-diagram ; markup category + instrument-specific-markup ; markup category (fret-diagram-verbose-markup) ; properties "Make a fret diagram markup using terse string-based syntax. @@ -823,7 +803,8 @@ with @code{-(} to start a barre and @code{-)} to end the barre. (car definition-list) (cdr definition-list)))) -(define (fret-parse-terse-definition-string props definition-string) +(define-public + (fret-parse-terse-definition-string props definition-string) "Parse a fret diagram string that uses terse syntax; return a pair containing: props, modified to include the string-count determined by the definition-string, and