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 } %}
>