| [tablatures] bend.ly - first corrections |
[ Thread Index |
Date Index
| More lilynet.net/tablatures Archives
]
- To: tablatures@xxxxxxxxxxx
- Subject: [tablatures] bend.ly - first corrections
- From: Marc Hohl <marc@xxxxxxxxxx>
- Date: Sun, 23 Aug 2009 19:47:26 +0200
- Dkim-signature: v=1; a=rsa-sha1; c=relaxed/relaxed; t=1251049647; l=26723; s=domk; d=hohlart.de; h=Content-Type:In-Reply-To:References:Subject:To:MIME-Version:From: Date:X-RZG-CLASS-ID:X-RZG-AUTH; bh=aisFIvduPC8VM8Kkfhc5uZxyGPY=; b=kU5ZrMp/f16xNA5oULw8BQWgCEpfueJuiUYuLjg3+k15AX0tD7jrHQj6q49/Fw5hDbV fWi7tgVYHtDjtZHamdPE/YJXzPEpN9HqO0o5StZ7ZUEFYIoTqSzHNLJ1tN1jKDC4uo3en 3LAdCGbnlgrl4zyB0ctSRxygHrWQNIcMbhA=
David Stocker schrieb:
Hi Marc, hi everyone,
Great work. This is really exciting.
Just a couple of comments:
1. It might be good to move the beginning point of the pointed slur
right about an eighth of a space and the end of the pointed slur
left by the same amount. This would make the space between the two
on notes that are bent to and then released more appreciable.
I did so in the latest version; see below.
2. For the example in bar 10, both of the pointed slurs should arch
under.
Ok, I corrected this, but it looks not perfect yet.
I'll fiddle around with some of the settings when I have the opportunity.
Kudos!
Thank you!
To make life easier for you testers, I split the file in two parts:
bend.ly contains the definitions, bendtest.ly is an example;
so you can easily \include "bend.ly" in your own files (and perhaps
tablature.ly - I don't know when 2.13.4 will be released).
You can change the values defined at the beginning of bend.ly
to your needs - let me know which values look best.
Marc
David
%
% bend.ly
%
% preliminary tests for drawing bends
% 2009-08-13
%
% Marc Hohl
%
% TODO:
% - draw dashed line for \holdBend
% - enable consecutive bend ups
% - simplify \preBend and \holdBend usage
% - ...
#(display "\n\nbend.ly â?? 2009-08-23\n\n")
%%% sizes and values (to be changed/adapted):
% the line thickness of bends and stuff:
#(define bend-line-thickness 0.1)
% the height of pointed slurs is fixed regardless of its width
% (TODO: should this be changed?):
#(define pointed-slur-height 2.0)
% the linear amount of the bend arrow (TODO: find a better name?)
#(define bend-ratio 0.35)
% the distance between the topmost tablature line and the arrow head
#(define bend-dy 2.75)
% the height of the bend arrow head:
#(define bend-arrow-height 1.25)
% the width of the arrow head base:
#(define bend-arrow-width 0.8)
% the distance between the tablature line where a bend starts
% and the starting point in vertical direction:
#(define bend-y-offset 0.35)
%%% internal commands
#(define-public (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 #:center-column (outstring))))
#(define-markup-command (drawHoldBend layout props
thickness begin-x end-x line-y)
(number? number? number? number?)
(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))))
#(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
#: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
#:bold #:center-column (outstring))))
#(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-public (slur::draw-pointed-slur grob)
(let* (;;(pointed-slur-height 2.0)
;;(bend-line-thickness 0.1)
(control-points (ly:grob-property grob 'control-points))
(direction (ly:grob-property grob 'direction))
(left-point (car control-points))
(right-point (cadddr control-points))
(begin-x (+ (car left-point) 0.125)) ;; due to David's proposals
(begin-y (cdr left-point))
(end-x (- (car right-point) 0.125)) ;; due to David's proposals
(end-y (cdr right-point))
(middle-x (/ (+ begin-x end-x) 2))
(middle-y (/ (+ begin-y end-y) 2))
(normal-x (* direction (- begin-y end-y)))
(normal-y (* direction (- end-x begin-x)))
(normal-length (sqrt (+ (* normal-x normal-x)
(* normal-y normal-y))))
(point-x (+ middle-x (* pointed-slur-height
(/ normal-x normal-length))))
(point-y (+ middle-y (* pointed-slur-height
(/ normal-y normal-length)))))
(grob-interpret-markup grob
(make-pointedSlur-markup bend-line-thickness
begin-x begin-y point-x point-y end-x end-y))))
#(define-public (slur::draw-bend-arrow grob)
(let* (;;(bend-line-thickness 0.1)
;;(bend-ratio 0.35)
;;(bend-dy 2.75)
;;(bend-arrow-height 1.25)
;;(bend-arrow-width 0.8)
;;(bend-y-offset 0.35)
(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)
bend-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) bend-dy))
(arrow-lx (- end-x (/ bend-arrow-width 2)))
(arrow-rx (+ end-x (/ bend-arrow-width 2)))
(arrow-y (- end-y bend-arrow-height))
(middle-x (+ begin-x (* bend-ratio (- 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-arrow-height))
(set! bend-amount "")
(ly:grob-set-property! right-tab-note-head 'stencil
(lambda (grob) (parenthesize-tab-note-head grob))))
;; 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-public (slur::draw-pre-bend-hold grob)
(let* (;;(bend-line-thickness 0.1)
;;(bend-dy 2.75)
;;(bend-arrow-height 1.25)
;;(bend-arrow-width 0.8)
;;(bend-y-offset 0.35)
(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) bend-dy))
(arrow-lx (- begin-x (/ bend-arrow-width 2)))
(arrow-rx (+ begin-x (/ bend-arrow-width 2)))
(arrow-y (- end-y bend-arrow-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-public (slur::draw-pre-bend-only grob)
(let* (;;(bend-line-thickness 0.1)
;;(bend-dy 2.75)
;;(bend-arrow-height 1.25)
;;(bend-arrow-width 0.8)
(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) bend-dy))
(arrow-lx (- begin-x (/ bend-arrow-width 2)))
(arrow-rx (+ begin-x (/ bend-arrow-width 2)))
(arrow-y (- end-y bend-arrow-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-public (tie::draw-hold-bend grob)
(let* (;;(bend-line-thickness 0.1)
;;(bend-dy 2.75)
;;(bend-arrow-height 1.25)
;;(bend-arrow-width 0.8)
(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) bend-dy)))
(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))))
%%% music functions
bendOn = {
\override Voice.Slur #'stencil = #slur::draw-pointed-slur
\override TabVoice.Slur #'stencil = #slur::draw-bend-arrow
}
bendOff = {
\revert Voice.Slur #'stencil
\override TabVoice.Slur #'stencil = ##f
%\override TabVoice.Slur #'direction = #UP
}
bendGrace = #(define-music-function (parser location note) (ly:music?)
#{
\once \override Voice.Stem #'stencil = ##f
\once \override Voice.Stem #'direction = #DOWN
\once \override Voice.Slur #'direction = #UP
\grace $note
#})
preBendOnly = #(define-music-function (parser location note) (ly:music?)
#{
\once \override TabVoice.Slur #'stencil = #slur::draw-pre-bend-only
\once \override TabStaff.ParenthesesItem #'transparent = ##t
\parenthesize $note
#})
preBend = #(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
\parenthesize $note
#})
holdBend = #(define-music-function (parser location) ()
#{
\once \override TabVoice.Tie #'stencil = #tie::draw-hold-bend
#})
\version "2.13.3"
\include "bend.ly"
\paper {
indent = 0
ragged-right = ##f }
%% the test
test = \relative c'' {
\bendOn
% First, some bends to see if they work from the topmost to the lowest string
c4 ( d )( c2 )
c4\2 ( d\2 )( c2\2 )
c4\3 ( des\3 )( c2\3 ) \break
c,4\4 ( d\4 )( c2\4 )
c4\5 ( d\5 )( c2\5 )
c4\6 ( d\6 )( c2\6 ) \break
% is the bend amount displayed correctly? (should be ½ in both cases)
c4 ( cis) d ( es )
% grace notes
\bendGrace c8( d4 )( c4 ) r2
% the distinction between \preBendOnly and \preBend is not very
% elegant here, I hope that there will be a better solution...
\bendGrace { \preBendOnly c8( } d2) r2
\bendGrace { \preBend c8( d)( } c2) r2
c4 ( es) e\2 ( gis\2 ) \break
% quarter tone bends are not yet supported as they should be, but
% the bend amount is calculated correctly ;-)
c,4 ( cih ) c4 ( cisih )
% I hope that in future releases the tie will recognize automagically
% that he ties to a note which is bent, but I don't know how (yet).
\bendGrace c'8 ( \holdBend d2 ) ~ d2 ( c1 )
\bendOff
% switching bends off works apparently
c,4 ( e ) c4 ( f )
c'4 ( b ) c4 ( a )
}
\score {
<<
\new Staff {
\new Voice {
\clef "G_8"
\test
}
}
\new TabStaff {
\new TabVoice {
\clef "tab"
\set TabStaff.stringTunings = #guitar-seven-string-tuning
\test
}
}
>>
}