X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Ffret-diagrams.scm;h=fb986f91b990f3589d48d05f883017aa2a559220;hb=f49e954f4a1c1c388ebe8c0581a20da0238aed25;hp=a305d944e6c04ec9d336af7ec024edb8a284d1ee;hpb=b59eedcb6fbda723022e42121880fb8c27618eda;p=lilypond.git diff --git a/scm/fret-diagrams.scm b/scm/fret-diagrams.scm index a305d944e6..fb986f91b9 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)) @@ -54,7 +54,7 @@ (subtract-base-fret base-fret (cdr dot-list)))))) (define (sans-serif-stencil layout props mag text) - "create a stencil in sans-serif font based on @var{layout} and @var{props} + "Create a stencil in sans-serif font based on @var{layout} and @var{props} with magnification @var{mag} of the string @var{text}." (let* ((my-props (prepend-alist-chain @@ -147,7 +147,7 @@ fret & string spacing by @var{size}. Orientation is given by @var{orientation}" (y1 (- half-thick)) (y2 (+ top-fret-thick half-thick)) (x-extent (cons (- x1) x2)) - (y-extent (cons 0 y2))) + (y-extent (cons sth top-fret-thick))) (if (eq? orientation 'normal) (ly:make-stencil (list 'round-filled-box x1 x2 y1 y2 sth) x-extent y-extent) @@ -185,7 +185,7 @@ Line thickness is given by @var{th}, fret & string spacing by (scale-dot-thick (* size dot-thickness)) (dot-color (assoc-get 'dot-color details 'black)) (finger-xoffset -0.25) - (finger-yoffset (- (* size 0.5))) + (finger-yoffset (* -0.5 size )) (dot-label-font-mag (* scale-dot-radius (assoc-get 'dot-label-font-mag details 1.0))) (string-label-font-mag @@ -295,7 +295,7 @@ Line thickness is given by @var{th}, fret & string spacing by glyph-stencil)))) (define (make-bezier-sandwich-list start stop base height thickness orientation) - " Make the argument list for a bezier sandwich from + "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." @@ -366,7 +366,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) @@ -435,12 +436,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) @@ -496,7 +497,7 @@ indications per string. (make-fret-diagram layout props marking-list)) (define (make-fret-diagram layout props marking-list) - " Make a fret diagram markup" + "Make a fret diagram markup" (let* ( ; note: here we get items from props that are needed in this routine, ; or that are needed in more than one of the procedures @@ -547,11 +548,14 @@ indications per string. (xo-list (cdr (assoc 'xo-list parameters))) (fret-range (cdr (assoc 'fret-range parameters))) (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 @@ -682,7 +686,7 @@ Note: There is no limit to the number of fret indications per string. layout (car definition-list) (cdr definition-list)))) (define (fret-parse-definition-string props definition-string) - "parse a fret diagram string and return a pair containing: + "Parse a fret diagram string and return a pair containing: props, modified as necessary by the definition-string a fret-indication list with the appropriate values" (let* ((fret-count 4) @@ -750,7 +754,7 @@ Note: There is no limit to the number of fret indications per string. `(,props . ,output-list))) ;ugh -- hard-coded spell -- procedure better (define (cons-fret new-value old-list) - " Put together a fret-list in the format desired by parse-string " + "Put together a fret-list in the format desired by parse-string" (if (eq? old-list '()) (list new-value) (cons* new-value old-list))) @@ -823,7 +827,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 @@ -896,7 +901,7 @@ with @code{-(} to start a barre and @code{-)} to end the barre. `(,props . ,output-list))) ; ugh -- hard coded; proc is better (define (drop-paren item-list) - " drop a final parentheses from a fret indication list + "Drop a final parentheses from a fret indication list resulting from a terse string specification of barre." (if (> (length item-list) 0) (let* ((max-index (- (length item-list) 1)) @@ -907,7 +912,7 @@ with @code{-(} to start a barre and @code{-)} to end the barre. item-list)) (define (get-sub-list value master-list) - " Get a sub-list whose cadr is equal to @var{value} from @var{master-list}" + "Get a sub-list whose cadr is equal to @var{value} from @var{master-list}" (if (eq? master-list '()) #f (let ((sublist (car master-list)))