Brilliant! I realized that defining the glissando gradient taking the stencil as point of departure, rather than the grob properties, makes it work for broken glissandi too. It was a quite minimal change.
(gliss-gradient (/ (+ (- (car stil-y-ext) (cdr stil-y-ext)) (* half-line-thick
2))
(+ (- (car stil-x-ext) (cdr stil-x-ext)) (*
half-line-thick 2))
(if (> Y-right Y-left) 1 -1)))
Like
glissando-stems-05.ly
Description: Binary data
> 22 okt. 2019 kl. 13:33 skrev Thomas Morley <thomasmorle...@gmail.com>: > > Am Sa., 19. Okt. 2019 um 12:36 Uhr schrieb Thomas Morley > <thomasmorle...@gmail.com>: > >> Meanwhile I've probably found a method to affect Beams from inside a >> Glissando.after-line-breaking, but currently it's not mature to say >> more. >> Anyway, my goal will be to make Beams parallel to the glissando-line, >> I don't think doing differnt makes any sense. > > Attached the next iteration. > Per default all Beams are parallel to the glissando. > Though, I implemented the possibility to reset their position by using > the new introduced subproperty beamed-glissando-stem-positions of > details. > See examples (with unusual values, just to see it works) > > Broken glissandi are not yet supported, the code will not error, but > the numerical calculations are not longer correct in this case. > > At any rate, the code becomes a monster lol > > Cheers, > Harm
\version "2.19.83"
#(define (make-cross-stencil coords)
(let ((thick 0.1)
(sz 0.2))
(ly:stencil-add
(make-line-stencil
thick
(- (car coords) sz)
(- (cdr coords) sz)
(+ (car coords) sz)
(+ (cdr coords) sz))
(make-line-stencil
thick
(- (car coords) sz)
(+ (cdr coords) sz)
(+ (car coords) sz)
(- (cdr coords) sz)))))
#(define (line-gradient x-positions y-positions)
(/
(- (cdr y-positions)
(car y-positions))
(- (cdr x-positions)
(car x-positions))))
%% Glissando has no pointer to the covered NoteColumns, because in most
%% traditional music NoteColumns are *not* skipped.
%% Thus reading those NoteColumns is inconvenient.
#(define (glissando-and-stems pad-y)
(lambda (grob)
(let* ((layout (ly:grob-layout grob))
(blot (ly:output-def-lookup layout 'blot-diameter))
(staff-space (ly:staff-symbol-staff-space grob))
(half-line-thick (/ (ly:staff-symbol-line-thickness grob) 2))
(original (ly:grob-original grob))
(left-bound (ly:spanner-bound original LEFT))
(right-bound (ly:spanner-bound original RIGHT))
(left-bound-when (grob::when left-bound))
(right-bound-when (grob::when right-bound))
(stil (ly:grob-property grob 'stencil))
;(stil (ly:line-spanner::print grob))
(stil-x-ext (ly:stencil-extent stil X))
(stil-y-ext (ly:stencil-extent stil Y))
(left-bound-info (ly:grob-property grob 'left-bound-info))
(X-left (assoc-get 'X left-bound-info))
(Y-left (assoc-get 'Y left-bound-info))
(left-padding (assoc-get 'padding left-bound-info))
(right-bound-info (ly:grob-property grob 'right-bound-info))
(X-right (assoc-get 'X right-bound-info))
(Y-right (assoc-get 'Y right-bound-info))
(gliss-gradient (/ (- Y-right Y-left) (- X-right X-left)))
(sys (ly:grob-system grob))
(sys-elts-array (ly:grob-object sys 'all-elements))
(ncs
(filter
(lambda (elt)
(let (;; Going for `ly:grob-relative-coordinate´ disturbs
;; vertical spacing, thus we sort/filter using
;; `grob::when´
(elt-when (grob::when elt)))
(and
(grob::has-interface elt 'note-column-interface)
(ly:grob-property elt 'glissando-skip #f)
(ly:grob-array? (ly:grob-object elt 'note-heads))
(ly:moment<? left-bound-when elt-when)
(not (ly:moment<? right-bound-when elt-when)))))
(ly:grob-array->list sys-elts-array)))
;; Stems from all NoteColumns covered by the Glissando
(stems
(map
(lambda (nc) (ly:grob-object nc 'stem))
ncs))
;; Mmhh, why do we need that?
(stem-begin-positions
(map
(lambda (stem)
(ly:grob-property stem 'stem-begin-position))
stems))
(stem-x-coord-proc
(lambda (nc)
(ly:grob-relative-coordinate (ly:grob-object nc 'stem) sys X)))
(stems-x-coords
(map stem-x-coord-proc ncs))
;; TODO for broken glissandi this is not exact
(gliss-stem-intersections
(map
(lambda (stem-x-coord)
(cons
;; TODO do we need the x-value at all?
(+
(- stem-x-coord X-left)
(- (car stil-x-ext) left-padding)
half-line-thick)
(+
(*
gliss-gradient
(+
(- stem-x-coord X-left)
(- (car stil-x-ext) left-padding)
half-line-thick
(- (+ (car stil-x-ext) half-line-thick))))
(if (negative? gliss-gradient)
(- (cdr stil-y-ext) half-line-thick)
(+ (car stil-y-ext) half-line-thick)))))
stems-x-coords)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; For conveniance/debugging
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Color left/right bound
;;;;;;;;;;;;;;;;;;;;;;
;(ly:grob-set-property! left-bound 'color red)
;(ly:grob-set-property! right-bound 'color green)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Color passed note-heads
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;(for-each
; (lambda (nh)
; (ly:grob-set-property! nh 'transparent #f)
; (ly:grob-set-property! nh 'stencil (ly:note-head::print nh))
; (ly:grob-set-property! nh 'color cyan))
; (append-map
; (lambda (nc)
; (ly:grob-array->list (ly:grob-object nc 'note-heads)))
; ncs))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Add cross-stencils where Stem and Glissando intersect
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;(ly:grob-set-property! grob 'stencil
; (apply ly:stencil-add
; (ly:grob-property grob 'stencil)
; (map make-cross-stencil gliss-stem-intersections)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Recreate Stem.stencil to match the glissando
;; Move Flag
;; Move Script
;; Recreate Beam.stencil, probably relying on user-specifications
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(for-each
(lambda (gsi stem)
(let* ((stem-y-ext (ly:grob-extent stem stem Y))
(stem-dir (ly:grob-property stem 'direction))
(pap-col (ly:item-get-column stem))
(pap-col-elts-array (ly:grob-object pap-col 'elements))
(scripts
(filter
(lambda (elt)
(grob::has-interface elt 'script-interface))
(ly:grob-array->list pap-col-elts-array)))
(beam (ly:grob-object stem 'beam))
(beamed-stems
(if (ly:grob? beam)
(ly:grob-array->list (ly:grob-object beam 'stems))
#f))
(beamed-stems-max-dur
(if beamed-stems
(apply
max
(map
(lambda (stem)
(ly:grob-property stem 'duration-log))
beamed-stems))
#f))
(beam-details
(if (ly:grob? beam)
(ly:grob-property beam 'details)
#f))
;; Get a possible user-override for
;; Beam.details.beamed-glissando-stem-positions
(beamed-glissando-stem-positions
(if beam-details
(assoc-get
'beamed-glissando-stem-positions
beam-details
#f)
#f))
(beam-x-positions
(if (ly:grob? beam)
(ly:grob-property beam 'X-positions)
#f))
;; Calculate beam-gradient, but only if the user specified
;; an override for Beam.details.beamed-glissando-stem-positions
(beam-gradient
(if (and beam-x-positions
beamed-glissando-stem-positions)
(line-gradient
beam-x-positions
beamed-glissando-stem-positions)
#f))
(beamed-stem-corrs
;; If the user sets details.beamed-glissando-stem-positions,
;; the usual calculation (further below) of the stem's length
;; will fail.
;; Thus we need to calculate some values to have the beamed
;; stems fit into that beam. These values are stored together
;; with it's Stem-grob in an alist and referenced below.
(if (and (ly:grob? beam) beam-gradient)
(let* ((beamed-ncs
(map
(lambda (stem) (ly:grob-parent stem X))
beamed-stems))
(x-coords (map stem-x-coord-proc beamed-ncs))
(x-coord-diffs
(map
(lambda (coord) (- coord (car x-coords)))
x-coords))
(corrs
(map
(lambda (stem coord)
(cons stem (* coord beam-gradient)))
beamed-stems
x-coord-diffs)))
corrs)
0))
(new-stem-y-ext
;; The numerical numbers here are my choice - Harm
(ordered-cons
(+ (cdr gsi) (* stem-dir pad-y))
(if beamed-glissando-stem-positions
;; Add the relevant values of beamed-stem-corrs
;; if needed.
(+ (car beamed-glissando-stem-positions)
(assoc-get stem beamed-stem-corrs))
(+ (* stem-dir 3.4 staff-space)
(* 0.5
stem-dir
staff-space
(if (and beamed-stems-max-dur
(member stem beamed-stems))
(- beamed-stems-max-dur 3.5)
(max
0
(- (ly:grob-property stem 'duration-log)
3))))
(cdr gsi)
(* stem-dir pad-y)))))
(flag (ly:grob-object stem 'flag))
(flag-stil
(if (ly:grob? flag)
(ly:grob-property flag 'stencil #f)
#f)))
;;;;;;;;;;;
;; recreate Beam.stencil
;;;;;;;;;;;
;; Relies on new setting of 'positions derived from new-stem-y-ext
;; Renewing quantized-positions is needed to get the stencil correct
;; The new beam is always parallel to the glissando, unless a
;; user-override takes priority
(if (ly:grob? beam)
(begin
(ly:grob-set-property! beam 'positions
(if beamed-glissando-stem-positions
beamed-glissando-stem-positions
(cons
(if (equal? stem (car beamed-stems))
(if (positive? stem-dir)
(cdr new-stem-y-ext)
(car new-stem-y-ext))
(car (ly:grob-property beam 'positions)))
(if (equal? stem (last beamed-stems))
(if (positive? stem-dir)
(cdr new-stem-y-ext)
(car new-stem-y-ext))
(cdr (ly:grob-property beam 'positions))))))
(ly:grob-set-property! beam 'quantized-positions
(ly:beam::set-stem-lengths beam))
(ly:grob-set-property! beam 'stencil (ly:beam::print beam))))
;;;;;;;;;;;
;; move scripts according to new Stem.stencil below
;;;;;;;;;;;
(if (pair? scripts)
(for-each
(lambda (i script)
(let* ((script-stil (ly:grob-property script 'stencil))
(script-y-off (ly:grob-property script 'Y-offset))
(script-padding (ly:grob-property script 'padding)))
;; TODO Scripts should avoid staff-lines!
;; Special-case some scripts?
(ly:grob-set-property! script 'stencil
(ly:stencil-translate-axis
(ly:grob-property script 'stencil)
(+
;; move script to zero-line
(- script-y-off)
;; move script to glissando-line
(cdr gsi)
;; Apply one staff-space padding for each script.
;; There are probably multiple ones per
;; NoteColumn
(* i staff-space stem-dir -1)
(* script-padding stem-dir -1))
Y))))
(iota (length scripts) 1 1)
scripts))
;;;;;;;;;;;
;; move Flag.stencil according to new Stem.stencil below
;;;;;;;;;;;
(if flag-stil
(let ((default-stem-end
(if (positive? stem-dir)
(cdr stem-y-ext)
(car stem-y-ext)))
(new-stem-end
(if (positive? stem-dir)
(cdr new-stem-y-ext)
(car new-stem-y-ext))))
(ly:grob-set-property! flag 'stencil
(ly:stencil-translate-axis
flag-stil
(- new-stem-end default-stem-end)
Y))))
;;;;;;;;;;;
;; recreate a new Stem.stencil
;;;;;;;;;;;
(ly:grob-set-property! stem 'stencil
(ly:round-filled-box
(ly:grob-extent stem stem X)
new-stem-y-ext
blot))))
gliss-stem-intersections
stems))))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% EXAMPLES
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Not essential, only to ease testings
multipleTransposes =
#(define-music-function (parser location m music)(ly:music? ly:music?)
(music-clone m
'elements
(map (lambda (pitch)
(ly:music-property #{ \transpose c $pitch $music #} 'element))
(event-chord-pitches m))))
glissOn = {
\temporary \override NoteColumn.glissando-skip = ##t
\temporary \override NoteHead.stem-attachment = #'(0 . 0)
%% making NoteHeads transparent, rather than outputting point-stencil
%% makes for better spacing
%\temporary \override NoteHead.stencil = #point-stencil
\temporary \override NoteHead.transparent = ##t
\temporary \override NoteHead.no-ledgers = ##t
\temporary \override Accidental.stencil = ##f
%% Do we need the line below?
%\temporary \override Stem.no-stem-extend = ##t
}
glissOff = {
\revert NoteColumn.glissando-skip
\revert NoteHead.stem-attachment
%\revert NoteHead.stencil
\revert NoteHead.transparent
\revert NoteHead.no-ledgers
\revert Accidental.stencil
\revert Stem.no-stem-extend
}
\paper { ragged-right = ##f }
\transpose c c'
{
% \voiceTwo
\override Glissando.after-line-breaking = #(glissando-and-stems 0)
% \override Glissando.breakable = ##t
c''4\glissando
\glissOn
%% For automatic Beams, set the values carefully
\once \override Beam.details.beamed-glissando-stem-positions = #'(-4 . -8)
b'8-.
b'->
\repeat unfold 4 bes'32-.
%% For manual Beams set the direction accordingly.
\once \override Beam.details.beamed-glissando-stem-positions = #'(4 . 8)
bes'8-.^[
a'64*8-_
aes']-.---\prall
% \break
g'2
\glissOff
fis2
}
mus = {
c''4\glissando
\glissOn
b'8-.
\noBeam
b'->
bes'-.
\noBeam
bes'8-.[
a'64*8-_
aes']-.---\prall
%\break
g'2
\glissOff
fis'2
}
%{
\multipleTransposes {
c,
d, e, f, g, a, b,
c d e f
g a b
}
{
\override NoteHead.layer = -1000
\override Glissando.breakable = ##t
\override Glissando.after-line-breaking = #(glissando-and-stems 0)
\mus
}
%}
>
