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
}
%}
_______________________________________________
lilypond-user mailing list
lilypond-user@gnu.org
https://lists.gnu.org/mailman/listinfo/lilypond-user
