I tried to do a few analysis diagrams following the LinuxJournal
example (quoted on the lilypond examples page):
https://www.linuxjournal.com/article/8364
(and also quite outdated, since it was written for Lilypond 2.6).
I think I have a proof of concept (see attached file)
for a version that is simpler to type than the LinuxJournal example
(it now preserves information locality: I do not need to enter any
note more than once).
The way I do this is by attaching “extra data” to notes, as
articulations, indicating how to draw them in the graph, such as:
\white - draw a white note head on this note
\beamR - beam to the right (and add a white note head if none defined)
\slurAL - slur to the right and above (and add a black note head if
none defined). Then some Scheme function parses this and blows out the
music to several voices in the same way as in the LJ example.
And now I have a question. For simplicity of entry (and readability of
source code), I would really really like to have shortcuts in the
style of dashHat, dashPlus etc. Namely, instead of \white, \black,
\beam, \beamR, \slurAL I would prefer (for example) -o, -*, -|, -[, -(
.
Would a patch to the C code enabling such shortcuts be envisageable?
(I don't see them interfering too much with what exists now, since
they only raise syntax errors now).
\version "2.18"
#(begin
(define (create-articulation . l);<<<
"creates an articulation with invisible output and specified properties"
(define-event-function () ()
(apply make-music (append (list 'TextScriptEvent 'text "") l)))
);>>>
(define (voicelead-find-articulation-prop m p);<<<
"returns the first value found for property p in an articulation of m"
" (or #f if not found)"
(let* (
(a (ly:music-property m 'articulations '()))
(b (map (lambda (x) (ly:music-property x p #f)) a))
)
(find (lambda (x) x) b)
));>>>
(define (voicelead-duration-to d x);<<<
"converts duration d to a duration (x 0 y) with same length"
(let* (
(q (ly:moment-main (ly:duration-length d)))
; arriver à q en partant de 2^(-x)
(y (/ q (expt 2 (- x))))
)
(ly:make-duration x 0 y)
));>>>
(define (voicelead-note-heads! m);<<<
"keep only note heads in the melody m, according to the voicelead-head
property"
(cond
((ly:music-property m 'elements #f)
(map voicelead-note-heads! (ly:music-property m 'elements)))
((ly:music-property m 'element #f)
(voicelead-note-heads! (ly:music-property m 'element)))
((eq? (ly:music-property m 'name) 'NoteEvent) (let* (
(h (voicelead-find-articulation-prop m 'voicelead-head))
)
(cond
((eq? h 'white)
(ly:music-set-property! m 'duration
(voicelead-duration-to (ly:music-property m 'duration) 1)))
((eq? h 'black)
(ly:music-set-property! m 'duration
(voicelead-duration-to (ly:music-property m 'duration) 2)))
; if no head defined and has a beam, then white head
((voicelead-find-articulation-prop m 'voicelead-beam)
(ly:music-set-property! m 'duration
(voicelead-duration-to (ly:music-property m 'duration) 1)))
; if no head defined and has a slur, then black head
((voicelead-find-articulation-prop m 'voicelead-slur)
(ly:music-set-property! m 'duration
(voicelead-duration-to (ly:music-property m 'duration) 2)))
(else (ly:music-set-property! m 'name 'SkipEvent))
)
(ly:music-set-property! m 'articulations '())
m ))
(else m)
) m);>>>
(define (voicelead-note-beams! m);<<<
"keep only note beams in the melody m, according to the voicelead-stem
property"
(cond
((ly:music-property m 'elements #f)
(map voicelead-note-beams! (ly:music-property m 'elements)))
((ly:music-property m 'element #f)
(voicelead-note-beams! (ly:music-property m 'element)))
((eq? (ly:music-property m 'name) 'NoteEvent) (let* (
(h (voicelead-find-articulation-prop m 'voicelead-beam))
)
(ly:music-set-property! m 'articulations '())
(if h
(ly:music-set-property! m 'duration
(voicelead-duration-to (ly:music-property m 'duration) 3))
(ly:music-set-property! m 'name 'SkipEvent))
(if (or (eq? h -1) (eq? h 1))
(ly:music-set-property! m 'articulations (list
(make-music 'BeamEvent 'span-direction h))))
m ))
(else m)
) m);>>>
(define (voicelead-note-slurs! m x);<<<
"keep only note beams in the melody m, according to the voicelead-stem
property"
(cond
((ly:music-property m 'elements #f)
(map (lambda (y) (voicelead-note-slurs! y x))
(ly:music-property m 'elements)))
((ly:music-property m 'element #f)
(voicelead-note-slurs! (ly:music-property m 'element) x))
((eq? (ly:music-property m 'name) 'NoteEvent) (let* (
(h (voicelead-find-articulation-prop m 'voicelead-slur))
)
(ly:music-set-property! m 'articulations '())
(ly:music-set-property! m 'duration
(voicelead-duration-to (ly:music-property m 'duration) 0))
(if (eq? h x)
(ly:music-set-property! m 'articulations (list
(make-music 'SlurEvent 'span-direction 1))))
(if (eq? h (- x))
(ly:music-set-property! m 'articulations (list
(make-music 'SlurEvent 'span-direction -1))))
m ))
(else m)
) m);>>>
(define voiceLeadDiagram (define-music-function;<<<
(parser location music) (ly:music?)
#{ <<
{
\override NoteColumn.ignore-collision = ##t
\omit Stem \omit Flag
#(voicelead-note-heads! (ly:music-deep-copy music))
} \\
{
\override NoteColumn.ignore-collision = ##t
\omit NoteHead
#(voicelead-note-beams! (ly:music-deep-copy music))
} \\
{
\hideNotes
\slurUp
#(voicelead-note-slurs! (ly:music-deep-copy music) 1)
} \\
{
\hideNotes
\slurDown
#(voicelead-note-slurs! (ly:music-deep-copy music) 2)
}
>> #}
));>>>
)% begin
% Definition of custom articulations%<<<
% + use a black head if no head defined *and* a slur is defined;
% + use a white head if no head defined *and* a beam is defined
white = #(create-articulation 'voicelead-head 'white)
black = #(create-articulation 'voicelead-head 'black)
beam = #(create-articulation 'voicelead-beam #t)
beamR = #(create-articulation 'voicelead-beam -1)
beamL = #(create-articulation 'voicelead-beam 1)
% slurs A, C up; B, D down
slurAR = #(create-articulation 'voicelead-slur -1)
slurAL = #(create-articulation 'voicelead-slur 1)
slurBR = #(create-articulation 'voicelead-slur -2)
slurBL = #(create-articulation 'voicelead-slur 2)
%>>>
% qux = \relative { a8\beamR\slurAR[( b\black] c) d\beamL\slurAL }
qux = \relative {
c'8\beamR d\slurAR\slurBR e\white f\black g\beam\slurAL
a b\slurBR
c\beamL\slurBL }
\paper { ragged-bottom = ##t }
\score { \new StaffGroup <<
\new Staff { \qux }
\new Staff { \voiceLeadDiagram \qux }
>> }
% \score { a8-* b c-[ d-] }
_______________________________________________
lilypond-user mailing list
[email protected]
https://lists.gnu.org/mailman/listinfo/lilypond-user
