| [tablatures] bend.ly - please test and comment |
[ Thread Index |
Date Index
| More lilynet.net/tablatures Archives
]
- To: tablatures@xxxxxxxxxxx
- Subject: [tablatures] bend.ly - please test and comment
- From: Marc Hohl <marc@xxxxxxxxxx>
- Date: Thu, 13 Aug 2009 17:17:48 +0200
- Dkim-signature: v=1; a=rsa-sha1; c=relaxed/relaxed; t=1250176670; l=26463; s=domk; d=hohlart.de; h=Content-Type:Subject:To:MIME-Version:From:Date:X-RZG-CLASS-ID: X-RZG-AUTH; bh=tD03DAuCBcfxtMxHqLJ1PUw55gc=; b=bSa7EqP/BvJ8z9vQAMO1L0simXKwj3kV+EWfQSdcjVLaynxhchF8pI5Bob38X6+HrQy wM88BkhWor1CbFr2aGasrhHaFqy2KELbkemijPyukhwbLDws1/s1MM3l1q3/b8NOV3YTy DSeC3DJ1DrNnIA5hdlxnsF47od0fVqITuYw=
Hello tablature users group,
here is my first attempt to bends.
I have made some changes, so I can cover most of the cases David has
sent to us some time ago.
When version 2.13.4 will be released, everything will be fine; in the
meantime
you'll probably have to \include "tablature.ly" - otherwise there will
be spurious
stems and stuff in the tablature.
What's important: please test the commands, fiddle around with the values
defined in the first few lines - I hope the variable names are
self-explanatory;
if not, call me.
The syntax "problem" is not relevant at this early stage, but I would
like to
simplify the structure; for example, the callback should recognize two
consecutive calls automagically, as in
\bendOn c4 ( d )( e )( c ) \bendOff
the same holds for ties
\bendOn c2 ( d ) ~ d ( c ) \bendOff
would definitely be better than
\bendOn c2 ( \holdBend ) ~ d ( c ) \bendOff
And if there is a possibility to check whether a slur points to a grace
note or not,
I could get rid of the distinction between \preBend and \preBendOnly
(silly name, you
can guess which commmand I'd like to drop :-)
Ok, so much for now, have fun!
Marc
%
% 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-13\n\n")
\version "2.13.3"
\paper {
indent = 0
ragged-right = ##f }
%%% 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))
(begin-y (cdr left-point))
(end-x (car right-point))
(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
\parenthesize $note
#})
holdBend = #(define-music-function (parser location) ()
#{
\once \override TabVoice.Tie #'stencil = #tie::draw-hold-bend
#})
%% the test (finally!)
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
}
}
>>
}