Am Fr., 22. Okt. 2021 um 15:45 Uhr schrieb Thomas Morley
<[email protected]>:
>
> Am Fr., 22. Okt. 2021 um 14:48 Uhr schrieb Thomas Morley
> <[email protected]>:
> >
> > Am Fr., 22. Okt. 2021 um 14:33 Uhr schrieb Dimitris Marinakis
> > <[email protected]>:
> > >
> > > I'd really like to test this version but I'm getting an error :
> > > In procedure ly:grob-object in expression (ly:grob-object stem (quote
> > > glissandi) ...):
> > > Wrong number of arguments to #<primitive-procedure ly:grob-object>
> >
> > You need a more recent version, 2.23.3 works here, because I make
> > frequent use of that new feature, thanks Jean.
> >
> > I had not updated the \version
> >
> > Sorry for that,
> > Harm
>
> Next iteration attached, it solves the most annoying issue with
> wrongly placed Script.
>
> Thanks Jean !
>
> Now tackling issue 03 (see resulting pdf) with cross-staff glissando-stems ...
>
> Cheers,
> Harm
Attachment missing...
\version "2.23.3"
#(define glissando-stems
(lambda (grob)
"If @code{NoteColumn.glissando-skip} is set to this procedure, a glissando
skips this @code{NoteColumn} grob and the @code{details.glissando-stems}
property is set @code{#t}."
(ly:grob-set-nested-property! grob '(details glissando-stems) #t)
#t))
#(define-public (line-spanner-gradient stencil grob)
"Takes a line-spanner @var{grob} grob and returns the gradient of the line
looking at @var{stencil}."
(if (and (grob::has-interface grob 'line-interface)
(grob::has-interface grob 'line-spanner-interface))
(let* ((left-bound-info (ly:grob-property grob 'left-bound-info))
(Y-left (assoc-get 'Y left-bound-info))
(X-left (assoc-get 'X left-bound-info))
(left-padding (assoc-get 'padding left-bound-info))
(right-bound-info (ly:grob-property grob 'right-bound-info))
(Y-right (assoc-get 'Y right-bound-info))
(X-right (assoc-get 'X right-bound-info))
(right-padding (assoc-get 'padding right-bound-info))
(x-ext (ly:stencil-extent stencil X))
(y-ext (ly:stencil-extent stencil Y))
(line-thickness (ly:staff-symbol-line-thickness grob))
(grob-thickness (ly:grob-property grob 'thickness #f))
(thick (or grob-thickness line-thickness)))
(/
(- (interval-length y-ext) thick)
(- (interval-length x-ext) thick)
(if (>= (- Y-right Y-left) 0) 1 -1)))
(begin
(ly:warning "Grob ~a is not a line-spanner, returning zero" grob)
0)))
#(define-public (line-spanner-stem-intersection-points refp note-columns grob)
"Takes the @code{Stem} grobs of @var{note-columns} and calculates the
intersection points of @var{grob}, supposed to be a line-spanner, with Y-axis of
the @code{Stem} grobs."
(let* ((grob-relative-coord (ly:grob-relative-coordinate grob refp X))
;; TODO use thicknesses at all? See next TODO
;(line-thickness (ly:staff-symbol-line-thickness grob))
;(half-line-thick (/ line-thickness 2))
;(grob-thickness (ly:grob-property grob 'thickness #f))
;(thick (or grob-thickness line-thickness))
;; stencil-stuff
;; NB ly:line-spanner::print adds half-line-thick to both sides of
;; the line
(stil (ly:line-spanner::print grob))
(stil-x-ext (ly:stencil-extent stil X))
(stil-y-ext (ly:stencil-extent stil Y))
;; left-bound-stuff
(left-bound-info (ly:grob-property grob 'left-bound-info))
(X-left (assoc-get 'X left-bound-info))
(gradient (line-spanner-gradient stil grob))
;; stem-stuff
(stems
(filter-map
(lambda (nc) (ly:grob-object nc 'stem #f))
note-columns))
(stems-x-coords
(map
(lambda (stem) (ly:grob-relative-coordinate stem refp X))
stems)))
;; resulting intersection-points
(map
(lambda (stem-x-coord)
(cons
;; X-coord
(- stem-x-coord
grob-relative-coord)
;; Y-coord
(+
;; Calculate and add the Y-value of the line-spanner at
;; the given stem
;; NB The result is relative to zero-staff-line.
(*
gradient
(- stem-x-coord
grob-relative-coord
(car stil-x-ext)))
;; Thus add the relevant value of line-spanner's y-extent:
;; If the line-spanner points down, use top y-extent,
;; if it points up use bottom y-extent.
;; TODO corrected by half thick? I.e.:
;(if (negative? gradient)
; (- (cdr stil-y-ext) (/ thick 2))
; (+ (car stil-y-ext) (/ thick 2)))
(if (negative? gradient)
(cdr stil-y-ext)
(car stil-y-ext)))))
stems-x-coords)))
#(define adjust-stems-beams
(lambda (grob)
"Moves @code{NoteHead} grobs passed by one or more glissando lines to the most
distant glissando line, viewed from the @code{Stem} side.
The @code{Stem.details} subproperties for @code{lengths} (for unbeamed
@code{Stem} grobs) and @code{beamed-minimum-free-lengths} (for beamed
@code{Stem} grobs) are adjusted to avoid most collisions with glissando lines."
(let* ((raw-stems
(cond ((grob::has-interface grob 'stem-interface) (list grob))
((grob::has-interface grob 'beam-interface)
(let ((stems-array (ly:grob-object grob 'stems)))
(if (ly:grob-array? stems-array)
(ly:grob-array->list stems-array)
'())))
(else '())))
(stems
(filter
(lambda (stem)
(ly:grob-object stem 'glissandi #f))
raw-stems)))
;; Proceed only with stems with a passing Glissando, stop if there
;; arent' any.
(if (pair? stems)
(let* (;; We search all Stems, because sometimes a Glissando starting
;; at a beamed Stem may be overlooked.
;; Delete duplicate findings.
(glissandi
(delete-duplicates
(append-map
(lambda (stem)
(let ((glissandi-array
(ly:grob-object stem 'glissandi #f)))
(if glissandi-array
(ly:grob-array->list glissandi-array)
'())))
stems)))
;; Get the bounds of a Glissando. We may not wish to move these
;; NoteHeads, see below
(gliss-bounds
(append-map
(lambda (gliss)
(list
(ly:spanner-bound gliss LEFT)
(ly:spanner-bound gliss RIGHT)))
glissandi))
;; All NoteColumns: start, end and in-between
(parent-ncs
(map
(lambda (stem) (ly:grob-parent stem X))
stems))
(nhds-lists
(map
(lambda (nc)
(let* ((nhds-array (ly:grob-object nc 'note-heads #f)))
(if nhds-array
(ly:grob-array->list nhds-array)
'())))
parent-ncs))
;; All NoteHeads with their 'staff-position
;; NB It is a nested list with sublists of note-heads per
;; note-column
(nhds-staff-pos-lists
(map
(lambda (nhds)
(map
(lambda (nhd)
(cons nhd (ly:grob-property nhd 'staff-position)))
nhds))
nhds-lists))
(stem-gliss-intersection-points
(map
(lambda (gliss)
(line-spanner-stem-intersection-points
(ly:grob-system grob)
parent-ncs
gliss))
glissandi))
;; We are interested in the y-coords of each intersection point
;; y-coords per Glissando
(stem-gliss-y-list
(map
(lambda (l) (map cdr l))
stem-gliss-intersection-points))
;; y-coords per Stem
(y-list
(if (pair? stem-gliss-y-list)
(apply zip stem-gliss-y-list)
'()))
(max-ys
(if (pair? y-list)
(map (lambda (x) (apply max x)) y-list)
'()))
(min-ys
(if (pair? y-list)
(map (lambda (x) (apply min x)) y-list)
'()))
(max-diffs
(map
(lambda (y1 y2) (- y1 y2))
max-ys
min-ys))
(dir (ly:grob-property grob 'direction))
(relevant-y-vals
(if (positive? dir)
min-ys
max-ys)))
#t
;; move note-heads to glissando line
(for-each
(lambda (nhds-staff-pos-list val)
(for-each
(lambda (nhd-staff-pos)
(if (and (pair? nhd-staff-pos)
(not (member (car nhd-staff-pos) gliss-bounds)))
(begin
(ly:grob-translate-axis!
(car nhd-staff-pos)
;; If NoteHead.Y-offset is set zero before, its
;; sufficient to use `val', otherwise take
;; half of staff-position into account
val
;(+ (/ (cdr nhd-staff-pos) -2) val)
Y))))
nhds-staff-pos-list))
nhds-staff-pos-lists
relevant-y-vals)
;; adjust Stem.details.lengths by the current distance between
;; top and bottom glissandi lines, will be zero if only one
;; glissando is present
(if (grob::has-interface grob 'stem-interface)
(ly:grob-set-nested-property! grob
'(details lengths)
(map
(lambda (x) (+ (car max-diffs) x))
(assoc-get 'lengths (ly:grob-property grob 'details)))))
;; adjust beamed-minimum-free-lengths
(if (grob::has-interface grob 'beam-interface)
(for-each
(lambda (stem val)
(let ((details (ly:grob-property stem 'details)))
(ly:grob-set-nested-property! stem
'(details beamed-minimum-free-lengths)
(map
(lambda (x) (+ x val))
(assoc-get
'beamed-minimum-free-lengths details)))))
stems
max-diffs)))))))
#(define stem::adjust-for-glissando
(lambda (grob)
"Moves @code{NoteHead} grobs of an unbeamed @code{Stem} grob to a glissando
line. This procedure is supposed to be the value of the @code{Stem.stencil}
property."
;; If Beam is present simply return default stencil.
;; Else move NoteHead grobs to sit upon the most distant glissando line
;; (viewed from Stem).
;; If only one glissando line is present, take that line.
;; Stem.details.lengths for multiple glissando lines is adjusted.
;; Finally return (new) default stencil.
(let* ((beam (ly:grob-object grob 'beam)))
(if (ly:grob? beam)
(ly:stem::print grob)
(begin
;; Move NoteHeads to glissando line
(adjust-stems-beams grob)
(ly:grob-set-property! grob 'positioning-done #t)
;; return default stencil
(ly:stem::print grob))))))
#(define beam::adjust-for-glissando
(lambda (grob)
"Moves @code{NoteHead} grobs of a beamed @code{Stem} grob to a glissando line.
Respects user overrides for @code{Beam.details.glissando-positions}, let them
replace the default @code{(beam::place-broken-parts-individually grob)}.
This procedure is supposed to be the value of the @code{Beam.positions}
property."
;; Overriding Beam.positions with this procedure needs to be applied
;; before the Beam is started.
;; Thus we put it as general setting in the engraver, see below.
(let* ((positions (assoc-get 'positions (ly:grob-basic-properties grob))))
;; Move NoteHeads to glissando line
;; Stem.details.beamed-minimum-free-lengths is adjusted for multiple
;; glissando lines
(adjust-stems-beams grob)
;; Respect user-override for Beam.positions
(if (procedure? positions)
(positions grob)
;(beam::place-broken-parts-individually grob)
positions))))
#(define Glissando_pointers_engraver
(lambda (context)
"Adds pointers from @code{Glissando} grobs to @code{NoteColumn} grobs and
from @code{Stem} grobs to passing @code{Glissando} grobs.
Sets @code{Beam.positions} to @code{beam::adjust-for-glissando}."
(let ((start-glissando #f)
(note-columns '())
(glissandi '())
(passed-stems '()))
(make-engraver
(acknowledgers
((beam-interface engraver grob source-engraver)
(ly:grob-set-property! grob 'positions beam::adjust-for-glissando))
((glissando-interface engraver grob source-engraver)
(set! start-glissando #t)
(set! glissandi (cons grob glissandi)))
((note-column-interface engraver grob source-engraver)
(let* ((details (ly:grob-property grob 'details))
(glissando-stems? (assoc-get 'glissando-stems details #f)))
(if (and start-glissando glissando-stems?)
(let* ((nhds (ly:grob-object grob 'note-heads))
(nhds-list
(if (ly:grob-array? nhds)
(ly:grob-array->list nhds)
'()))
(stem (ly:grob-object grob 'stem)))
(set! passed-stems (cons stem passed-stems))
(set! note-columns (cons grob note-columns)))))))
(end-acknowledgers
((glissando-interface engraver grob source-engraver)
(let* ((left-bound (ly:spanner-bound grob LEFT))
(right-bound (ly:spanner-bound grob RIGHT))
(left-nc
(if (grob::has-interface
left-bound
'note-head-interface)
(list (ly:grob-parent left-bound X))
'()))
(right-nc
;; check for right-bound being a grob, for glissandi
;; between unequal amounts of notes it may be not
(if (and (ly:grob? right-bound)
(grob::has-interface
right-bound
'note-head-interface))
(list (ly:grob-parent right-bound X))
'())))
;; put NoteColumn grobs into a 'note-columns-pointer of
;; Glissando, technically not needed for stemmed glissandi, but
;; nice to have
(for-each
(lambda (nc)
(ly:pointer-group-interface::add-grob
grob 'note-columns nc))
(append left-nc (reverse note-columns) right-nc))
;; add a pointer named 'glissandi to every passed Stem,
;; containing the Glissando grobs passing this Stem
;; exclude those glissandi without proper bounds, see above
(for-each
(lambda (gliss)
(for-each
(lambda (stem)
(if (and (ly:grob? left-bound) (ly:grob? right-bound))
(ly:pointer-group-interface::add-grob
stem 'glissandi gliss)))
passed-stems))
glissandi)
(set! start-glissando #f)
(set! passed-stems '())
(set! glissandi
(remove (lambda (gliss) (equal? grob gliss)) glissandi))
(if (null? glissandi)
(set! note-columns '())))))))))
#(ly:register-translator
Glissando_pointers_engraver 'Glissando_pointers_engraver
'((grobs-created . ())
(events-accepted . ())
(properties-read . ())
(properties-written . ())
(description . "\
Engraver to set pointers from @code{Glissando} grobs to @code{NoteColumns} grobs
and from @code{Stem} grobs to @code{Glissando} grobs.
Setting @code{Beam.positions} to @code{beam::adjust-for-glissando}")))
glissandoStemsOn =
#(define-music-function (mus) (ly:music?)
"@var{mus} is supposed to be a @code{note-event} or @code{event-chord} with
a starting glissando.
Applies certain overrides to get stems at the glissando."
;; We do it as a music-function to gain the possibility to set it before `mus'.
;; This way it is more in line with the usage of commands like
;; \arpeggioArrowUp etc
#{
$mus
\temporary \override NoteColumn.glissando-skip = #glissando-stems
\temporary \override NoteHead.stem-attachment = #'(0 . 0)
%% TODO keep this one?
%\temporary \override Stem.no-stem-extend = ##t
\temporary \override Stem.stencil = #stem::adjust-for-glissando
\temporary \override Stem.cross-staff = ##t
\temporary \override NoteHead.no-ledgers = ##t
\temporary \override Accidental.stencil = ##f
%% Don't confuse LilyPond with suspended NoteHeads
\temporary \override NoteHead.X-offset = ##f
% \temporary \override NoteHead.color = #grey
% \temporary \override NoteHead.layer = -1000
%% Make NoteHead transparent, omitting stencil or using point-stencil
%% will sometimes result in bad horizontal spacing
\temporary \override NoteHead.transparent = ##t
\temporary \override NoteHead.Y-offset = 0
#})
glissandoStemsOff = {
\revert NoteColumn.glissando-skip
\revert NoteColumn.details.glissando-stems
\revert NoteHead.stem-attachment
\revert NoteHead.X-offset
\revert Stem.cross-staff
% \revert Stem.no-stem-extend
\revert Stem.stencil
\revert NoteHead.no-ledgers
\revert Accidental.stencil
\revert NoteHead.color
\revert NoteHead.layer
\revert NoteHead.transparent
\revert NoteHead.Y-offset
}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% USAGE
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#(ly:set-option 'debug-skylines #t)
\paper {
indent = 0
ragged-right = ##t
}
\layout {
\context {
\Voice
\override Glissando.breakable = ##t
\consists "Glissando_pointers_engraver"
}
}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% ISSUES
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\markup
\rounded-box \rounded-box
\fill-line { \fontsize #3 \bold "Issues" \null }
%% Script
\markup
\pad-around #2
\fill-line {
"01 Script-grobs etc may be placed wrongly (with workaround)"
\bold "solved"
}
%{
correctScripts =
#(define-music-function (val)(number?)
#{
\once \override Script.quantize-position = ##f
\once \override Script.staff-padding = $val
\once \override Fingering.staff-padding = $val
\once \override StringNumber.staff-padding = $val
\once \override StrokeFinger.staff-padding = $val
#})
<<
{
\glissandoStemsOn
b''4\glissando
g''-.-!->
\glissandoStemsOff
b'''2
}
{
\glissandoStemsOn
b''4\glissando
\correctScripts 3.6
g''-.-!->
\glissandoStemsOff b'''2
}
>>
%}
% {
%% Beam.direction
\markup
\column {
\draw-hline
\pad-around #2
"02 Direction of Beams differ with stemmed glissando. Work around with
\\voiceXxx, \\stemUp ..."
}
<<
\relative c'' {
c16b a g
f e d c
b a g f
e d c b
}
\relative c'' {
\glissandoStemsOn
c16\glissando b a g
f e d c
b a g f
e d c \glissandoStemsOff b
}
>>
%}
% {
%% cross-staff glissando-stems don't work
\markup
\column {
\draw-hline
\pad-around #2 "03 cross-staff glissando-stems doesn't work"
}
\new PianoStaff
<<
\new Staff = "top"
\relative e'' {
\voiceOne
\glissandoStemsOn
c16\glissando
b a g f e d c
\change Staff = "bottom"
b a g f e d c b
a g f e d c b a
\glissandoStemsOff
g2
}
\new Staff = "bottom" { \clef "bass" s1*2 }
>>
%}
%%%%%%%%%%%%%%%%%%%%%%%
%% EXAMPLES
%%%%%%%%%%%%%%%%%%%%%%%
% {
\markup
\rounded-box \rounded-box
\fill-line { \fontsize #3 \bold "Examples" \null }
\markup \pad-around #2 "Multiple Glissandi, chords, Beam over Rest, line breaks"
\transpose c c' {
%\voiceTwo
\glissandoStemsOn
<ces e'>4\glissando
<ees c'''' >128*32[-!-.->
f''''16*2-!-.->
r
<cis'' e''>8*2]-!-.->
\glissandoStemsOff
\glissandoStemsOn
<e'' gis''>2-!
\glissando
<e'' g''>4
\glissandoStemsOff
q
\break
\glissandoStemsOn
<ces' e'>1\glissando
<c'' e''>4 <c'' e''''>8[-!-.-> <c'' e''''>]-!-.-> q4 q
\break
<c'' e''>8
r
<cis'' e''>4
\glissandoStemsOff
\set glissandoMap = #'((0 . 0) (0 . 1))
\glissandoStemsOn
e''2\glissando
gis''8*8
\glissandoStemsOff
<e' gis''>1
}
%}
% {
\markup
\pad-around #2
"Restricted to current Staff, user override for Beam.positions is respected"
<<
\new Staff \transpose c c {
\voiceOne
\glissandoStemsOn
b8\glissando
c'16 d
\once \override Beam.positions = #'(5 . 10)
e' f' g' c'16 d' e' f' g'
c'16 d'
\glissandoStemsOff
b'8
}
\new Staff \fixed c'' {
d'8-> g-> c-> f,-> bes,,-> ees,,->r4
}
>>
%}
% {
\markup \pad-around #2 "Start/end inside Beam"
{
g16[
ais
\glissandoStemsOn
b\glissando
b
d'' e bis bes \glissandoStemsOff a'
b']
}
%}
% {
\markup \pad-around #2 "Steep Glissandi"
{
\set beamExceptions = #'()
\voiceTwo
\glissandoStemsOn d'''8\glissando[ g'' c'' f'] \glissandoStemsOff bes2
\glissandoStemsOn d'''8 \glissando g'' c'' f' \glissandoStemsOff bes2
}
%}
