Why is the TabNoteHead printed in the attached example?
It happens only when using a chord.
A related question: if this is not a bug and I'm forced to tweak the
transparency of the TabNoteHead, how can I save the tweak in a
variable? I think that it's not possible and I should use a function
instead, right?
Harm, any ideas? (see comments in the attached file)
Thanks
Federico
\version "2.19.43"
\include "bend.ily"
myMusic = \relative {
e,8 b' e\4 e b' e r4 |
\bendOn
% the bendings are printed correctly
g,4( gih) g'( gih)
% if I use a chord, the gih' TabNoteHead (3 1/2) appears
<g, g'>2( <gih gih'>)
% disabling the TabNoteHead with a tweak is cumbersome in my real score (because it's repeated several times)
% I cannot save a \tweak in a variable, right?
<g g'>( <gih \tweak TabNoteHead.transparent ##t gih'>)
}
\score {
\new StaffGroup <<
\new Staff { \clef "treble_8" \myMusic }
\new TabStaff \with {
stringTunings = \stringTuning <e, b, e e b e'>
}
{ \clef "moderntab" \new TabVoice \myMusic }
>>
\layout {
indent = 0
\context {
\Score
supportNonIntegerFret = ##t
}
\context {
\StaffGroup
\override StaffGrouper.staff-staff-spacing.padding = #5
}
}
}
\version "2.18.0"
\header {
oll-title = "Guitar string bending notation"
oll-author = "Marc Hohl"
oll-description = \markup {
This snippet allows to typeset bend symbols -
typically used on guitar - on Staff and TabStaff.
While issue 1196 aims to create a specific engraver
for bends, this snippet leverages the slur engraver.
}
}
% TODO:
% - draw dashed line for \holdBend
% - enable consecutive bend ups
% - simplify \preBend and \holdBend usage
% - ...
%%% sizes and values (to be changed/adapted):
#(define bend-line-thickness 0.1)
#(define bend-arrow-curvature-factor 0.35)
#(define y-distance-from-tabstaff-to-arrow-tip 2.75)
#(define consecutive-bends-arrow-height 2.75)
#(define bend-arrowhead-height 1.25)
#(define bend-arrowhead-width 0.8)
#(define y-distance-from-staffline-to-arrow 0.35)
%%% internal commands
#(define (quarterdiff->string quarterdiff)
(let ((wholesteps (floor (/ quarterdiff 4))))
(string-append (case wholesteps
((0) "")
(else (number->string wholesteps)))
(case (modulo quarterdiff 4)
((1) "¼")
((2) "½")
((3) "¾")
(else "")))))
%%% markup commands
#(define-markup-command (pointedSlur layout props thickness bx by mx my ex ey)
(number? number? number? number? number? number? number?)
(interpret-markup layout props
(markup #:postscript
(ly:format "~f setlinewidth
~f ~f moveto
~f ~f lineto
~f ~f lineto stroke" thickness bx by mx my ex ey))))
#(define-markup-command (drawBendArrow layout props
thickness begin-x middle-x end-x begin-y end-y
arrow-lx arrow-rx arrow-y outstring)
(number? number? number? number? number? number? number? number? number?
string?)
(interpret-markup layout props
(markup #:postscript
(ly:format "~f setlinewidth
~f ~f moveto
~f ~f lineto
~f ~f ~f ~f ~f ~f curveto
stroke
~f ~f moveto
~f ~f lineto
~f ~f lineto
closepath fill"
thickness
begin-x begin-y
middle-x begin-y
middle-x begin-y end-x begin-y end-x arrow-y
arrow-lx arrow-y
end-x end-y
arrow-rx arrow-y)
#:hspace 0
#:translate (cons (- end-x 1.2) (+ end-y 0.5))
#:fontsize -2
#:bold
;; changed:
;#:center-column (outstring)
outstring
)))
#(define-markup-command (drawHoldBendWithArrow layout props
thickness begin-x begin-y end-x end-y arrow-lx
arrow-rx arrow-y outstring)
(number? number? number? number? number? number? number? number? string?)
(interpret-markup layout props
(markup #:postscript
(ly:format "~f setlinewidth
~f ~f moveto
~f ~f lineto
stroke
~f ~f moveto
~f ~f lineto
~f ~f lineto
closepath fill
~f ~f moveto
~f ~f lineto
stroke"
thickness
begin-x begin-y
begin-x arrow-y
arrow-lx arrow-y
begin-x end-y
arrow-rx arrow-y
begin-x end-y
end-x end-y)
#:hspace 0
#:translate (cons (- begin-x 1.2) (+ end-y 0.5))
#:fontsize -2
;; Why does it work here??
#:bold #:center-column (outstring))))
#(define-markup-command (drawHoldBendArrowOnly layout props
thickness begin-x begin-y end-x end-y arrow-lx
arrow-rx arrow-y outstring)
(number? number? number? number? number? number? number? number? string?)
(interpret-markup layout props
(markup #:postscript
(ly:format "~f setlinewidth
~f ~f moveto
~f ~f lineto
stroke
~f ~f moveto
~f ~f lineto
~f ~f lineto
closepath fill"
thickness
begin-x begin-y
begin-x arrow-y
arrow-lx arrow-y
begin-x end-y
arrow-rx arrow-y)
#:hspace 0
#:translate (cons (- begin-x 1.2) (+ end-y 0.5))
#:fontsize -2
;; Why does it work here??
#:bold #:center-column (outstring))))
%% The markup-command 'draw-dashed-line' was implemented with version 2.17.x
%% TODO: use 'draw-dashed-line' instead. See also 'tie::draw-hold-bend' below.
#(define-markup-command (drawDashedLine layout props
thickness begin-x end-x line-y)
(number? number? number? number?)
;; TODO: draws a full line instead of a dashed line
(interpret-markup layout props
(markup #:postscript
(ly:format "~f setlinewidth
~f ~f moveto
~f ~f lineto
stroke"
thickness begin-x line-y end-x line-y))))
%%% callbacks
#(define (slur::draw-pointed-slur grob)
(let* ((control-points (ly:grob-property grob 'control-points))
(direction (ly:grob-property grob 'direction))
(first-point (car control-points))
(second-point (cadr control-points))
(third-point (caddr control-points))
(forth-point (cadddr control-points))
(first-x (+ (car first-point) 0.125)) ;; due to David's proposals
(first-y (cdr first-point))
(second-x (car second-point))
(second-y (cdr second-point))
(third-x (car third-point))
(third-y (cdr third-point))
(forth-x (- (car forth-point) 0.125))
(forth-y (cdr forth-point))
(middle-x (/ (+ third-x second-x) 2))
(middle-y (/ (+ third-y second-y) 2)))
(grob-interpret-markup grob
(make-pointedSlur-markup bend-line-thickness
first-x first-y middle-x middle-y forth-x forth-y))))
#(define (slur::draw-bend-arrow grob)
(let* ((staff-symbol (ly:grob-object grob 'staff-symbol))
(line-count (ly:grob-property staff-symbol 'line-count))
(staff-space (ly:grob-property staff-symbol 'staff-space))
(left-bound (ly:spanner-bound grob LEFT))
(right-bound (ly:spanner-bound grob RIGHT))
(left-tab-note-head (ly:grob-property left-bound 'cause))
(right-tab-note-head (ly:grob-property right-bound 'cause))
(control-points (ly:grob-property grob 'control-points))
(left-point (car control-points))
;;changed: cadddr changed to last
(right-point (last control-points))
(left-pitch (ly:event-property (event-cause left-bound) 'pitch))
(right-pitch (ly:event-property (event-cause right-bound) 'pitch))
(quarterdiff (- (ly:pitch-quartertones right-pitch)
(ly:pitch-quartertones left-pitch)))
(begin-x (car left-point))
(begin-y (+ (* (/ (ly:grob-property left-tab-note-head
'staff-position) 2)
staff-space)
y-distance-from-staffline-to-arrow))
;; cdr left-point doesn't work, because invisible stems are included
(end-x (car right-point))
(end-y (+ (* (/ (- line-count 1) 2) staff-space)
y-distance-from-tabstaff-to-arrow-tip))
(arrow-lx (- end-x (/ bend-arrowhead-width 2)))
(arrow-rx (+ end-x (/ bend-arrowhead-width 2)))
(arrow-y (- end-y bend-arrowhead-height))
(middle-x (+ begin-x (* bend-arrow-curvature-factor (- end-x
begin-x))))
(bend-amount (quarterdiff->string quarterdiff)))
(if (< quarterdiff 0)
;; bend down
(let* ((y-offset (cdr (ly:grob-extent left-tab-note-head
left-tab-note-head Y)))
(temp begin-y))
(set! begin-y end-y) ;; swap begin-y/end-y
(set! end-y (+ temp y-offset))
(set! arrow-y (+ end-y bend-arrowhead-height))
(set! bend-amount "")
(ly:grob-set-property! right-tab-note-head 'display-cautionary #t)
(ly:grob-set-property! right-tab-note-head 'stencil
tab-note-head::print))
;; bend up
(let* ((x-offset (/ (cdr (ly:grob-extent left-tab-note-head
left-tab-note-head X))
2)))
(set! begin-x (+ begin-x x-offset))
(ly:grob-set-property! right-tab-note-head 'transparent #t)))
;; draw resulting bend arrow
(grob-interpret-markup grob
(make-drawBendArrow-markup
bend-line-thickness
begin-x middle-x end-x begin-y end-y
arrow-lx arrow-rx arrow-y
bend-amount))))
#(define (slur::draw-shifted-bend-arrow grob)
(let* ((staff-symbol (ly:grob-object grob 'staff-symbol))
(line-count (ly:grob-property staff-symbol 'line-count))
(staff-space (ly:grob-property staff-symbol 'staff-space))
(left-bound (ly:spanner-bound grob LEFT))
(right-bound (ly:spanner-bound grob RIGHT))
(left-tab-note-head (ly:grob-property left-bound 'cause))
(right-tab-note-head (ly:grob-property right-bound 'cause))
(control-points (ly:grob-property grob 'control-points))
(left-point (car control-points))
(right-point (cadddr control-points))
(left-pitch (ly:event-property (event-cause left-bound) 'pitch))
(right-pitch (ly:event-property (event-cause right-bound) 'pitch))
(quarterdiff (- (ly:pitch-quartertones right-pitch)
(ly:pitch-quartertones left-pitch)))
(begin-x (car left-point))
(begin-y (+ (* (/ (ly:grob-property left-tab-note-head
'staff-position) 2)
staff-space)
y-distance-from-tabstaff-to-arrow-tip))
;; cdr left-point doesn't work, because invisible stems are included
(end-x (car right-point))
(end-y (+ (* (/ (- line-count 1) 2) staff-space)
y-distance-from-tabstaff-to-arrow-tip consecutive-bends-arrow-height))
(arrow-lx (- end-x (/ bend-arrowhead-width 2)))
(arrow-rx (+ end-x (/ bend-arrowhead-width 2)))
(arrow-y (- end-y bend-arrowhead-height))
(middle-x (+ begin-x (* bend-arrow-curvature-factor (- end-x
begin-x))))
(bend-amount (quarterdiff->string quarterdiff)))
(if (< quarterdiff 0)
;; bend down
(let* ((y-offset (cdr (ly:grob-extent left-tab-note-head
left-tab-note-head Y)))
(temp begin-y))
(set! begin-y end-y) ;; swap begin-y/end-y
(set! end-y (+ temp y-offset))
(set! arrow-y (+ end-y bend-arrowhead-height))
(set! bend-amount "")
(ly:grob-set-property! right-tab-note-head 'stencil
(lambda (grob) (parenthesize-tab-note-head grob))))
;; bend up
(ly:grob-set-property! right-tab-note-head 'transparent #t))
;; draw resulting bend arrow
(grob-interpret-markup grob
(make-drawBendArrow-markup
bend-line-thickness
begin-x middle-x end-x begin-y end-y
arrow-lx arrow-rx arrow-y
bend-amount))))
#(define (slur::draw-pre-bend-hold grob)
(let* ((staff-symbol (ly:grob-object grob 'staff-symbol))
(line-count (ly:grob-property staff-symbol 'line-count))
(staff-space (ly:grob-property staff-symbol 'staff-space))
(left-bound (ly:spanner-bound grob LEFT))
(right-bound (ly:spanner-bound grob RIGHT))
(left-tab-note-head (ly:grob-property left-bound 'cause))
(right-tab-note-head (ly:grob-property right-bound 'cause))
(control-points (ly:grob-property grob 'control-points))
(left-point (car control-points))
(right-point (cadddr control-points))
(left-pitch (ly:event-property (event-cause left-bound) 'pitch))
(right-pitch (ly:event-property (event-cause right-bound) 'pitch))
(quarterdiff (- (ly:pitch-quartertones right-pitch)
(ly:pitch-quartertones left-pitch)))
(begin-x (car left-point))
(y-offset (cdr (ly:grob-extent left-tab-note-head left-tab-note-head
Y)))
(begin-y (+ (* (/ (ly:grob-property left-tab-note-head
'staff-position)
2)
staff-space)
y-offset))
;; cdr left-point doesn't work, because invisible stems are included
(end-x (car right-point))
(end-y (+ (* (/ (- line-count 1) 2) staff-space)
y-distance-from-tabstaff-to-arrow-tip))
(arrow-lx (- begin-x (/ bend-arrowhead-width 2)))
(arrow-rx (+ begin-x (/ bend-arrowhead-width 2)))
(arrow-y (- end-y bend-arrowhead-height))
(bend-amount (quarterdiff->string quarterdiff)))
(ly:grob-set-property! right-tab-note-head 'transparent #t)
;; draw resulting bend arrow
(grob-interpret-markup grob
(make-drawHoldBendWithArrow-markup
bend-line-thickness
begin-x begin-y
end-x end-y
arrow-lx arrow-rx arrow-y
bend-amount))))
#(define (slur::draw-pre-bend-only grob)
(let* ((staff-symbol (ly:grob-object grob 'staff-symbol))
(line-count (ly:grob-property staff-symbol 'line-count))
(staff-space (ly:grob-property staff-symbol 'staff-space))
(left-bound (ly:spanner-bound grob LEFT))
(right-bound (ly:spanner-bound grob RIGHT))
(left-tab-note-head (ly:grob-property left-bound 'cause))
(right-tab-note-head (ly:grob-property right-bound 'cause))
(control-points (ly:grob-property grob 'control-points))
(left-point (car control-points))
(right-point (cadddr control-points))
(left-pitch (ly:event-property (event-cause left-bound) 'pitch))
(right-pitch (ly:event-property (event-cause right-bound) 'pitch))
(quarterdiff (- (ly:pitch-quartertones right-pitch)
(ly:pitch-quartertones left-pitch)))
(begin-x (car left-point))
(y-offset (cdr (ly:grob-extent left-tab-note-head left-tab-note-head
Y)))
(begin-y (+ (* (/ (ly:grob-property left-tab-note-head
'staff-position)
2)
staff-space)
y-offset))
;; cdr left-point doesn't work, because invisible stems are included
(end-x (car right-point))
(end-y (+ (* (/ (- line-count 1) 2) staff-space)
y-distance-from-tabstaff-to-arrow-tip))
(arrow-lx (- begin-x (/ bend-arrowhead-width 2)))
(arrow-rx (+ begin-x (/ bend-arrowhead-width 2)))
(arrow-y (- end-y bend-arrowhead-height))
(bend-amount (quarterdiff->string quarterdiff)))
(ly:grob-set-property! right-tab-note-head 'transparent #t)
;; draw resulting bend arrow
(grob-interpret-markup grob
(make-drawHoldBendArrowOnly-markup
bend-line-thickness
begin-x begin-y
end-x end-y
arrow-lx arrow-rx arrow-y
bend-amount))))
#(define (tie::draw-hold-bend grob)
(let* ((staff-symbol (ly:grob-object grob 'staff-symbol))
(line-count (ly:grob-property staff-symbol 'line-count))
(staff-space (ly:grob-property staff-symbol 'staff-space))
(left-tab-note-head (ly:spanner-bound grob LEFT))
(right-tab-note-head (ly:spanner-bound grob RIGHT))
(control-points (ly:grob-property grob 'control-points))
(left-point (car control-points))
(right-point (cadddr control-points))
(begin-x (car left-point))
(end-x (car right-point))
(line-y (+ (* (/ (- line-count 1) 2) staff-space)
y-distance-from-tabstaff-to-arrow-tip)))
(ly:grob-set-property! right-tab-note-head 'transparent #t)
(grob-interpret-markup grob
(make-drawDashedLine-markup
bend-line-thickness
begin-x end-x line-y)
;; with 2.17.21 one could use:
;(make-translate-markup (cons 0 line-y)
; (make-override-markup '(on . 0.3)
; (make-draw-dashed-line-markup
; (cons end-x 0))))
)))
%%% music functions
bendOn =
#(define-music-function (parser location note) (ly:music?)
#{
\override Voice.Slur #'stencil = #slur::draw-pointed-slur
\override TabVoice.Slur #'stencil = #slur::draw-bend-arrow
$note \noBreak
#})
bendOff = {
\revert Voice.Slur #'stencil
\override TabVoice.Slur #'stencil = #slur::draw-tab-slur
}
bendGrace =
#(define-music-function (parser location note) (ly:music?)
#{
\once \override Voice.Stem #'stencil = #point-stencil
\once \override Voice.Flag #'stencil = ##f
\once \override Voice.Stem #'direction = #DOWN
\once \override Voice.Slur #'direction = #UP
\grace #note
#})
preBendHold =
#(define-music-function (parser location note) (ly:music?)
#{
\once \override TabVoice.Slur #'stencil = #slur::draw-pre-bend-only
\once \override TabStaff.ParenthesesItem #'transparent = ##t
<>\noBeam \parenthesize #note
#})
preBendRelease =
#(define-music-function (parser location note) (ly:music?)
#{
\once \override TabVoice.Slur #'stencil = #slur::draw-pre-bend-hold
\once \override TabStaff.ParenthesesItem #'transparent = ##t
\once \override Voice.Slur #'direction = #DOWN
<>\noBeam \parenthesize #note
#})
holdBend =
#(define-music-function (parser location) ()
#{
\once \override TabVoice.Tie #'stencil = #tie::draw-hold-bend
#})
shiftBend = {
\once \override TabVoice.Slur #'stencil = #slur::draw-shifted-bend-arrow
}
_______________________________________________
lilypond-user mailing list
lilypond-user@gnu.org
https://lists.gnu.org/mailman/listinfo/lilypond-user
