;;;;
;;;; 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))
+ (capo-fret 0)
(barre-list '())
(dot-list '())
(xo-list '())
(set! xo-list (cons* my-item xo-list)))
((eq? my-code 'barre)
(set! barre-list (cons* (cdr my-item) barre-list)))
+ ((eq? my-code 'capo)
+ (set! capo-fret (cadr my-item)))
((eq? my-code 'place-fret)
(set! dot-list (cons* (cdr my-item) dot-list))))
(parse-item (cdr mylist)))))
;; calculate fret-range
- (let ((maxfret 0) (minfret 99))
+ (let ((maxfret 0)
+ (minfret (if (> capo-fret 0) capo-fret 99)))
(let updatemax ((fret-list dot-list))
(if (null? fret-list)
'()
(list minfret
(let ((upfret (- (+ minfret fret-count) 1)))
(if (> maxfret upfret) maxfret upfret)))))
+ (set! capo-fret (1+ (- capo-fret minfret)))
; subtract fret from dots
(set! dot-list (subtract-base-fret (- (car fret-range) 1) dot-list)))
(acons 'fret-range fret-range
(acons 'barre-list barre-list
(acons 'dot-list dot-list
- (acons 'xo-list xo-list '()))))))
+ (acons 'xo-list xo-list
+ (acons 'capo-fret capo-fret '())))))))
(define (subtract-base-fret base-fret dot-list)
"Subtract @var{base-fret} from every fret in @var{dot-list}"
(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."
(ly:make-stencil (list 'round-filled-box y1 y2 x1 x2 sth)
y-extent x-extent))))
+(define (draw-capo details string-count fret fret-count th size
+ dot-pos orientation)
+ "Draw a capo indicator across the full width of the fret-board
+ at fret capo-fret."
+ (let* ((sth (* th size))
+ (capo-thick
+ (* size (assoc-get 'capo-thickness details 0.5)))
+ (half-thick (* capo-thick 0.5))
+ (last-string-pos 0)
+ (first-string-pos (* size (- string-count 1)))
+ (fret-pos ( * size (if (eq? orientation 'normal)
+ (+ 2 (- fret-count fret dot-pos))
+ (1- (+ dot-pos fret))))))
+ (if (eq? orientation 'normal)
+ (make-line-stencil capo-thick
+ last-string-pos fret-pos first-string-pos fret-pos)
+ (make-line-stencil capo-thick
+ fret-pos last-string-pos fret-pos first-string-pos))))
+
+
(define (draw-frets fret-range string-count th size orientation)
"Draw the fret lines for a fret diagram with
@var{string-count} strings and frets as indicated in @var{fret-range}.
(- 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."
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))))
(make-bezier-sandwich-list
(* size barre-start-string-coordinate)
(* size barre-end-string-coordinate)
- (* size (+ 2 (- top-fret (+ low-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
(* size (+ 1 label-vertical-offset)) X))))
(define-builtin-markup-command (fret-diagram-verbose layout props marking-list)
- (list?) ; argument type
- fret-diagram ; markup type
+ (pair?) ; argument type (list, but use pair? for speed)
+ instrument-specific-markup ; markup type
((align-dir -0.4) ; properties and defaults
(size 1.0)
(fret-diagram-details)
Place a barre indicator (much like a tie) from string @var{start-string}
to string @var{end-string} at fret @var{fret-number}.
+@item (capo @var{fret-number})
+Place a capo indicator (a large solid bar) across the entire fretboard
+at fret location @var{fret-number}. Also, set fret @var{fret-number}
+to be the lowest fret on the fret diagram.
+
@item (place-fret @var{string-number} @var{fret-number} @var{finger-value})
Place a fret playing indication on string @var{string-number} at fret
@var{fret-number} with an optional fingering label @var{finger-value}.
(label-space (* 0.25 size))
(label-dir (assoc-get 'label-dir details RIGHT))
(parameters (fret-parse-marking-list marking-list fret-count))
+ (capo-fret (assoc-get 'capo-fret parameters 0))
(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)
(draw-xo layout props string-count fret-range
size xo-list orientation)
xo-padding))))
+ (if (> capo-fret 0)
+ (set! fret-diagram-stencil
+ (ly:stencil-add
+ fret-diagram-stencil
+ (draw-capo details string-count capo-fret fret-count
+ th size dot-position orientation))))
(if (> (car fret-range) 1)
(set! fret-diagram-stencil
(if (eq? orientation 'normal)
(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
(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
projects / lilypond.git / blobdiff