;;;;
;;;; source file of the GNU LilyPond music typesetter
;;;;
-;;;; (c) 2004--2007 Carl D. Sorensen <c_sorensen@byu.edu>
+;;;; (c) 2004--2008 Carl D. Sorensen <c_sorensen@byu.edu>
(define (fret-parse-marking-list marking-list fret-count)
(let* ((fret-range (list 1 fret-count))
(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
(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)
(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."
(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)
(- 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."
(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
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))))
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."
(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)
(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
(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)
(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)
(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
(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
(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)
(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
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)
`(,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)))
(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.
(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
`(,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))
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)))