Hello Werner, hello Bophead, this is actually very trivial to tweak. It requires an adaptation of a single line and maybe some mechanism of specification. The appended file modifies the relevant code in such a way that fret-diagram-details.extra-string-length can be used to specify the extended string length in fret distances (1 for a single fret space). All that is required is a minor change in one line for printing and two added lines for scoping the parameter.
The appended file is intended for demonstration and a little bit naughty and should probably not be used extensively. Cheers, Valentin Am Mittwoch, 19. April 2023, 20:15:38 CEST schrieb Werner LEMBERG: > > There is something I do not like about the fret diagrams in > > Lilypond: > > > > The diagrams are "open" on the side pointing towards the bridge of > > the instrument, with the strings "sticking out" on that side. How > > could I achieve closed rectangles in Lilypond like e.g. the > > "MusFrets" font does? > > > > https://www.notationcentral.com/product/musfrets/ > > > > It is simply about a line drawn at the bottom (in the default > > direction) of the fret diagram, but I do not know enough scheme to > > do it. > > This sounds like a reasonable request, please file an issue at > > https://gitlab.com/lilypond/lilypond/-/issues/ > > together with some images. > > > It would be great if someone could show how to do that and that > > might as well be an option that could become standard in a future > > version. > > The complete fret diagram code is in Scheme file > `scm/fret-diagrams.com`. > > > Werner
%%% Create a binding to current module so we can get back there
#(module-define! (resolve-module '(lily)) 'mod (current-module))
%%% Change to lily module
#(set-current-module (resolve-module '(lily)))
%%% Taken from scm/fret-diagrams.scm
%%% Only changes are addition of lines 33,34
%%% and in 169 change from (1+ to (+ extra-string-length
#(define (make-fret-diagram layout props marking-list)
"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
;; called from this routine. If they're only used in one of the
;; sub-procedure, they're obtained in that procedure
(size (chain-assoc-get 'size props 1.0)) ; needed for everything
;;TODO -- get string-count directly from length of stringTunings;
;; from FretBoard engraver, but not from markup call
(details (merge-details 'fret-diagram-details props '()))
(fret-distance
(assoc-get 'fret-distance details 1.0))
(string-distance-from-details
(assoc-get 'string-distance details 1.0))
;; disable negative `string-distance'
;; mmh -- should we print a message/warning?
(string-distance (abs string-distance-from-details))
(handedness (assoc-get 'handedness details RIGHT))
(string-count
(assoc-get 'string-count details 6)) ;; needed for everything
(my-fret-count
(assoc-get 'fret-count details 4)) ;; needed for everything
(extra-string-length
(assoc-get 'extra-string-length details 1))
(orientation
(assoc-get 'orientation details 'normal)) ;; needed for everything
(finger-code
(assoc-get
'finger-code details 'none)) ;; needed for draw-dots and draw-barre
(default-dot-radius
(if (eq? finger-code 'in-dot) 0.425 0.25)) ;; bigger dots if labeled
(dot-radius
(assoc-get 'dot-radius details default-dot-radius))
(default-dot-position
(if (eq? finger-code 'in-dot)
(- 0.95 default-dot-radius)
0.6)) ; move up to make room for bigger dot if labeled
;; needed for draw-dots and draw-barre
(dot-position
(assoc-get 'dot-position details default-dot-position))
;; default thickness
;; needed for draw-dots and draw-barre
(th
(* (ly:output-def-lookup layout 'line-thickness)
(chain-assoc-get 'thickness props 0.5)))
;; needed for draw-frets and draw-strings
(sth (* size th))
(thickness-factor (assoc-get 'string-thickness-factor details 0))
(paren-padding (assoc-get 'paren-padding details 0.05))
(alignment (chain-assoc-get 'align-dir props -0.4)) ;; needed only here
(xo-padding (assoc-get 'xo-padding details 0.2)) ;; needed only here
(parameters (fret-parse-marking-list marking-list my-fret-count))
(capo-fret (assoc-get 'capo-fret parameters 0))
(dot-list (assoc-get 'dot-list parameters))
(xo-list (assoc-get 'xo-list parameters))
(fret-range (assoc-get 'fret-range parameters))
(my-fret-count (fret-count fret-range))
(barre-list (assoc-get 'barre-list parameters))
(barre-type (assoc-get 'barre-type details 'curved))
(fret-diagram-stencil '()))
;; Here are the fret diagram helper functions that depend on the
;; fret diagram parameters. The functions are here because the
;; diagram parameters are part of the lexical scope here.
(define (stencil-coordinates fret-coordinate string-coordinate)
"Return a pair @code{(x-coordinate . y-coordinate)}
in stencil coordinate system."
(cond
((eq? orientation 'landscape)
(cons fret-coordinate
(* handedness (- string-coordinate (1- string-count)))))
((eq? orientation 'opposing-landscape)
(cons (- fret-coordinate) (* handedness (- string-coordinate))))
(else
(cons (* handedness string-coordinate) (- fret-coordinate)))))
(define (stencil-coordinate-offset fret-offset string-offset)
"Return a pair @code{(x-offset . y-offset)}
for translation in stencil coordinate system."
(cond
((eq? orientation 'landscape)
(cons fret-offset (- string-offset)))
((eq? orientation 'opposing-landscape)
(cons (- fret-offset) string-offset))
(else
(cons string-offset (- fret-offset)))))
(define (make-bezier-sandwich-list start stop base height half-thickness)
"Make the argument list for a bezier sandwich from
string coordinate @var{start} to string-coordinate @var{stop} with a
baseline at fret coordinate @var{base}, a height of
@var{height}, and a thickness of @var{half-thickness}."
(let* ((width (1+ (- stop start)))
(cp-left-width (+ (* width half-thickness) start))
(cp-right-width (- stop (* width half-thickness)))
(bottom-control-point-height
(- base (- height half-thickness)))
(top-control-point-height
(- base height))
(left-start-end-point
(stencil-coordinates base start))
(right-end-point
(stencil-coordinates base stop))
(left-upper-control-point
(stencil-coordinates
top-control-point-height cp-left-width))
(left-lower-control-point
(stencil-coordinates
bottom-control-point-height cp-left-width))
(right-upper-control-point
(stencil-coordinates
top-control-point-height cp-right-width))
(right-lower-control-point
(stencil-coordinates
bottom-control-point-height cp-right-width)))
;; order of bezier control points is:
;; left cp start/end, left cp low, right cp low, right cp end,
;; right cp high, left cp high
;;
;; left-upper ← ← ← ← ← ← ← right-upper
;; ↙ left-lower → → right-lower ↖
;; ↙ ↗ ↘ ↖
;; left-start-end right-end
(list
left-start-end-point
left-lower-control-point
right-lower-control-point
right-end-point
right-upper-control-point
left-upper-control-point)))
(define (draw-strings)
"Draw the string lines for a fret diagram with
@var{string-count} strings and frets as indicated in @var{fret-range}.
Line thickness is given by @var{th}, fret & string spacing by
@var{size}. Orientation is determined by @var{orientation}."
(let* ((string-list (iota string-count 1 1))
(string-stencils (map string-stencil string-list)))
(apply ly:stencil-add empty-stencil string-stencils)))
(define (string-stencil string)
"Make a stencil for @code{string}, given the fret-diagram
overall parameters."
(let* ((string-coordinate (- string-count string))
(current-string-thickness
(* th size (string-thickness string thickness-factor)))
(fret-half-thick (* size th 0.5))
(string-half-thick (* current-string-thickness 0.5))
(start-coordinates
(stencil-coordinates
(- fret-half-thick)
(- (* size string-distance string-coordinate)
string-half-thick)))
(end-coordinates
(stencil-coordinates
(+ fret-half-thick
(* size fret-distance (+ extra-string-length (fret-count fret-range))))
(+ string-half-thick
(* size string-distance string-coordinate)))))
(ly:round-filled-box
(ordered-cons (car start-coordinates) (car end-coordinates))
(ordered-cons (cdr start-coordinates) (cdr end-coordinates))
(* th size))))
(define (draw-frets)
"Draw the fret lines for a fret diagram with
@var{string-count} strings and frets as indicated in @var{fret-range}.
Line thickness is given by @var{th}, fret & string spacing by
@var{size}. Orientation is given by @var{orientation}."
(let* ((fret-list (iota (1+ my-fret-count)))
(fret-stencils (map fret-stencil fret-list)))
(apply ly:stencil-add empty-stencil fret-stencils)))
(define (fret-stencil fret)
"Make a stencil for @code{fret}, given the
fret-diagram overall parameters."
(let* ((low-string-half-thickness
(* 0.5
size
th
(string-thickness string-count thickness-factor)))
(fret-half-thickness (* 0.5 size th))
(start-coordinates
(stencil-coordinates
(* fret-distance size fret)
(- fret-half-thickness low-string-half-thickness)))
(end-coordinates
(stencil-coordinates
(* fret-distance size fret)
(* size string-distance (1- string-count)))))
(make-line-stencil
(* size th)
(car start-coordinates) (cdr start-coordinates)
(car end-coordinates) (cdr end-coordinates))))
(define (draw-barre barre-list)
"Create barre indications for a fret diagram"
(let* ((low-fret (car fret-range))
(barre-vertical-offset 0.5)
(scale-dot-radius (* size dot-radius))
(barre-type (assoc-get 'barre-type details 'curved))
(barre-stils
(map
(lambda (barre)
(let* ((string1 (car barre))
(string2 (cadr barre))
(barre-fret (caddr barre))
(fret (1+ (- barre-fret low-fret)))
(barre-fret-coordinate
(+ (1- fret) dot-position))
(barre-start-string-coordinate
(- string-count string1))
(barre-end-string-coordinate
(- string-count string2)))
(cond
((eq? barre-type 'straight)
(make-straight-line-stencil
barre-fret-coordinate
barre-start-string-coordinate
barre-end-string-coordinate
scale-dot-radius))
((eq? barre-type 'curved)
(make-curved-barre-stencil
barre-fret-coordinate
barre-start-string-coordinate
barre-end-string-coordinate
scale-dot-radius)))))
barre-list)))
(apply ly:stencil-add empty-stencil barre-stils)))
(define (make-straight-line-stencil
fret
start-string
end-string
thickness)
"Create a straight line stencil. Used for barre and capo."
(let ((start-point
(stencil-coordinates
(* size fret-distance fret)
(* size string-distance start-string)))
(end-point
(stencil-coordinates
(* size fret-distance fret)
(* size string-distance end-string))))
(make-line-stencil
thickness
(car start-point) (cdr start-point)
(car end-point) (cdr end-point))))
(define (make-curved-barre-stencil
fret-coordinate
start-string-coordinate
end-string-coordinate
half-thickness)
"Create a curved barre stencil."
(let* ((bezier-thick 0.1)
(bezier-height 0.5)
(bezier-list
(make-bezier-sandwich-list
(* size string-distance start-string-coordinate)
(* size string-distance end-string-coordinate)
(* size fret-distance fret-coordinate)
(* size bezier-height)
(* size bezier-thick))))
(make-bezier-sandwich-stencil
bezier-list
(* size bezier-thick))))
(define (draw-dots dot-list)
"Make dots for fret diagram."
(let* ((scale-dot-radius (* size dot-radius))
(scale-dot-thick (* size th))
(default-dot-color (assoc-get 'dot-color details))
(finger-label-padding 0.3)
(dot-label-font-mag
(* scale-dot-radius
(assoc-get 'dot-label-font-mag details 1.0)))
(string-label-font-mag
(* size
(assoc-get
'string-label-font-mag details
(cond ((or (eq? orientation 'landscape)
(eq? orientation 'opposing-landscape))
0.5)
(else 0.6)))))
(dot-stils
(map
(lambda (dot-sublist)
(let* (
(current-string (car dot-sublist))
(fret (cadr dot-sublist))
(fret-coordinate
(* size fret-distance (+ (1- fret) dot-position)))
(string-coordinate
(* size string-distance (- string-count current-string)))
(dot-coordinates
(stencil-coordinates fret-coordinate string-coordinate))
(extent (cons (- scale-dot-radius) scale-dot-radius))
(parenthesized (dot-is-parenthesized dot-sublist))
(parenthesis-color (default-paren-color dot-sublist))
(inverted (dot-is-inverted dot-sublist))
(dot-color-is-white?
(or inverted
(and (eq? default-dot-color 'white) (not inverted))))
(what-color
(cond
;; If no colors are set return #f
;; This makes a general override of Grob.color affect
;; dot-color as well
((and (not (dot-has-color dot-sublist))
(not (assoc-get default-dot-color x11-color-list)))
#f)
((and inverted
(not (dot-has-color dot-sublist))
(not (eq? default-dot-color 'white)))
(x11-color (or default-dot-color 'black)))
(dot-color-is-white?
(x11-color
(or (dot-has-color dot-sublist) 'black)))
;; Other dots are colored with (in descending
;; priority order)
;; - dot-color
;; - general default-dot-color
;; - black as fallback
(else
(x11-color
(or (dot-has-color dot-sublist)
default-dot-color
'black)))))
(inverted-stil
(lambda (color)
(ly:stencil-add
(stencil-with-color
(make-circle-stencil
scale-dot-radius scale-dot-thick #t)
color)
(stencil-with-color
(make-circle-stencil
(- scale-dot-radius (* 0.5 scale-dot-thick)) 0 #t)
(x11-color 'white)))))
(dot-stencil
(if dot-color-is-white?
(inverted-stil what-color)
(stencil-with-color
(make-circle-stencil
scale-dot-radius scale-dot-thick #t)
what-color)))
(final-dot-stencil
(if parenthesized
(let ((paren-color
;; If 'default-paren-color is in dot-sublist
;; and dots are not white use the overall
;; color, i.e. return #f
;; Otherwise use `what-color`
(if (and parenthesis-color
(not (eq? default-dot-color 'white)))
#f
what-color)))
(stencil-with-color
(parenthesize-stencil
dot-stencil ;; stencil
(* size th 0.75) ;; half-thickness
(* 0.15 size) ;; width
0 ;; angularity
paren-padding ;; padding
)
paren-color))
dot-stencil))
(positioned-dot
(ly:stencil-translate final-dot-stencil dot-coordinates))
(finger (caddr dot-sublist))
(finger (if (number? finger) (number->string finger) finger)))
;;;;
;; the ready dot-stencil with fingering:
;;;;
;; - for finger-code 'none use positioned-dot from above
;; - for finger-code 'in-dot calculate a stencil for the
;; finger, add it to final-dot-stencil and move the result
;; accordingly
;; - for finger-code 'below-string calculate a stencil for
;; the finger, move it accordingly and add the result
;; to positioned-dot from above
(cond ((or (eq? finger '())
(eq? finger-code 'none)
(eq? finger-code *unspecified*))
positioned-dot)
((and (eq? finger-code 'in-dot) (not (null? finger)))
(let* ((finger-stil
(sans-serif-stencil
layout props dot-label-font-mag finger))
(finger-stil-length
(interval-length
(ly:stencil-extent finger-stil X)))
(finger-stil-height
(interval-length
(ly:stencil-extent finger-stil Y)))
(dot-stencil-radius
(/ (interval-length
(ly:stencil-extent dot-stencil Y))
2))
(scale-factor
(/ dot-stencil-radius
;; Calculate the radius of the circle
;; through the corners of the box
;; containing the finger-stil. Give it
;; a little padding.
;; The value, (* 2 th), is my choice
(+
(ly:length
(/ finger-stil-length 2)
(/ finger-stil-height 2))
(* 2 th))))
(finger-label-stil
(centered-stencil
(ly:stencil-scale
finger-stil
scale-factor scale-factor))))
(ly:stencil-translate
(ly:stencil-add
final-dot-stencil
(if dot-color-is-white?
(stencil-with-color
finger-label-stil
what-color)
(stencil-with-color
finger-label-stil white)))
dot-coordinates)))
((eq? finger-code 'below-string)
(let* ((finger-label-stencil
(centered-stencil
(sans-serif-stencil
layout props string-label-font-mag
finger)))
(finger-label-fret-offset
(stencil-fretboard-offset
finger-label-stencil 'fret orientation))
(finger-label-fret-coordinate
;; (1) Move the below-string-finger-codes to
;; the bottom edge of the string, i.e.
;; (* (1+ my-fret-count) fret-distance)
;; (2) add `finger-label-padding' (a hardcoded
;; correction-value to get a bit default
;; padding).
;; TODO: make it a property?
;; (3) scale this with `size'
;; (4) add `label-fret-offset', to get the
;; final padding
(+
(* size
(+ (* (1+ my-fret-count) fret-distance)
finger-label-padding))
finger-label-fret-offset))
(finger-label-translation
(stencil-coordinates
finger-label-fret-coordinate
string-coordinate)))
(ly:stencil-add
positioned-dot
(ly:stencil-translate
finger-label-stencil
finger-label-translation))))
(else
;; unknown finger-code, warn
(ly:warning
"Unknown finger-code ~a, ignoring." finger-code)
positioned-dot))))
dot-list)))
(apply ly:stencil-add empty-stencil dot-stils)))
(define (draw-thick-zero-fret)
"Draw a thick zeroth fret for a fret diagram whose base fret is 1.
Respect changes of @code{size} and
@code{fret-diagram-details.string-thickness-factor}."
(let* ((half-lowest-string-thickness
(* 0.5 sth (string-thickness string-count thickness-factor)))
(half-thick (* 0.5 sth))
(top-fret-thick
(* sth (assoc-get 'top-fret-thickness details 3.0)))
(start-string-coordinate
(- half-lowest-string-thickness))
(end-string-coordinate
(+ (* size string-distance (1- string-count)) half-thick))
(start-fret-coordinate half-thick)
(end-fret-coordinate (- half-thick top-fret-thick))
(lower-left
(stencil-coordinates
start-fret-coordinate start-string-coordinate))
(upper-right
(stencil-coordinates
end-fret-coordinate end-string-coordinate)))
(ly:round-filled-box
;; Put limits in order, or else the intervals are considered empty
(ordered-cons (car lower-left) (car upper-right))
(ordered-cons (cdr lower-left) (cdr upper-right))
sth)))
(define (draw-xo xo-list)
"Put open and mute string indications on diagram, as contained in
@var{xo-list}."
(let* ((xo-font-mag (assoc-get 'xo-font-magnification details 0.4))
(diagram-fret-top
(car (stencil-fretboard-extent
fret-diagram-stencil
'fret
orientation)))
(xo-stils
(map
(lambda (xo-sublist)
(let* ((glyph-string
(if (eq? (car xo-sublist) 'mute)
(assoc-get 'mute-string details "X")
(assoc-get 'open-string details "O")))
(glyph-string-coordinate
(* (- string-count (cadr xo-sublist))
string-distance size))
(glyph-stencil
(centered-stencil
(sans-serif-stencil
layout props
(* size xo-font-mag) glyph-string)))
(glyph-stencil-coordinates
(stencil-coordinates 0 glyph-string-coordinate)))
(ly:stencil-translate
glyph-stencil
glyph-stencil-coordinates)))
xo-list))
(xo-stencil (apply ly:stencil-add empty-stencil xo-stils))
(xo-fret-offset
(stencil-fretboard-offset xo-stencil 'fret orientation))
(xo-stencil-offset
(stencil-coordinate-offset
(- diagram-fret-top xo-fret-offset (* size xo-padding))
0)))
(ly:stencil-translate xo-stencil xo-stencil-offset)))
(define (draw-capo fret)
"Draw a capo indicator across the full width of the fret-board
at @var{fret}."
(let* ((capo-thick (* size (assoc-get 'capo-thickness details 0.5)))
(last-string-position 0)
(first-string-position (* size (- string-count 1)))
(fret-position (* size (1- (+ dot-position fret)))))
(make-straight-line-stencil
fret-position
last-string-position
first-string-position
capo-thick)))
(define (label-fret fret-range)
"Label the base fret on a fret diagram"
(let* ((base-fret (car fret-range))
(label-font-mag (assoc-get 'fret-label-font-mag details 0.5))
(label-space (* 0.5 size))
(label-dir (assoc-get 'label-dir details RIGHT))
(label-vertical-offset
(assoc-get 'fret-label-vertical-offset details 0))
(label-horizontal-offset
(assoc-get 'fret-label-horizontal-offset details 0))
(number-type
(assoc-get 'number-type details 'roman-lower))
(label-text
(number-format number-type base-fret
(assoc-get 'fret-label-custom-format
details "~a")))
(label-stencil
(centered-stencil
(sans-serif-stencil
layout props (* size label-font-mag) label-text)))
(label-half-width
(stencil-fretboard-offset
label-stencil
'string
orientation))
(label-outside-diagram
(+ label-space
(* size label-horizontal-offset)
label-half-width)))
(ly:stencil-translate
label-stencil
(stencil-coordinates
(* size fret-distance (1+ label-vertical-offset))
(if (eqv? label-dir LEFT)
(- label-outside-diagram)
(+ (* size string-distance (1- string-count))
label-outside-diagram))))))
;;;;
;; Here is the body of make-fret-diagram
;;;;
;; starting with an empty stencil,
;; add strings and frets
(set! fret-diagram-stencil
(ly:stencil-add (draw-strings) (draw-frets)))
;; add barre(s)
(if (and (not (null? barre-list))
(not (eq? 'none barre-type)))
(set! fret-diagram-stencil
(ly:stencil-add
(draw-barre barre-list)
fret-diagram-stencil)))
;; add dots
(if (not (null? dot-list))
(set! fret-diagram-stencil
(ly:stencil-add
fret-diagram-stencil
(draw-dots dot-list))))
;; add thick zero fret
(if (= (car fret-range) 1)
(set! fret-diagram-stencil
(ly:stencil-add
fret-diagram-stencil
(draw-thick-zero-fret))))
;; add open/mute indicators
(if (pair? xo-list)
(set! fret-diagram-stencil
(ly:stencil-add
fret-diagram-stencil
(draw-xo xo-list))))
;; add capo
(if (> capo-fret 0)
(set! fret-diagram-stencil
(ly:stencil-add
fret-diagram-stencil
(draw-capo capo-fret))))
;; add fret-label
(if (> (car fret-range) 1)
(set! fret-diagram-stencil
(ly:stencil-add
fret-diagram-stencil
(label-fret fret-range))))
(ly:stencil-aligned-to fret-diagram-stencil X alignment)))
%%% Done, change back to correct module
#(set-current-module mod)
%%% Test
\new FretBoards \chordmode {
c
\override FretBoard.fret-diagram-details.extra-string-length = #2
c
\override FretBoard.fret-diagram-details.extra-string-length = #0
c
\override FretBoard.fret-diagram-details.extra-string-length = #0.6
c
\override FretBoard.fret-diagram-details.extra-string-length = #-0.7
c
}
signature.asc
Description: This is a digitally signed message part.
