\version "2.19.83" %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% GLISSANDO WITH STEMS %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #(define (glissando-and-stems pad-y) "Returns the unchanged @code{Glissando}, @code{Stem}s from passed @code{NoteColumn}s are recreated to start at the glissando-line. @var{pad-y} may provide a padding-value. A @code{Flag} is moved to fit again with the new @code{Stem}. @code{Script} at a passed @code{NoteColumn} is moved to sit at note-head-side. Inner @code{Beam}s are recreated to be parallel to the glissando-line, unless an override for @code{Beam.details.beamed-glissando-stem-positions}, expecting a number-pair, is suppled. This is prefered. " ;; Glissando has no pointer to the covered NoteColumns, because in most ;; traditional music NoteColumns are *not* skipped. ;; Thus reading those NoteColumns is inconvenient... (lambda (grob) (let ((gliss-stil (ly:grob-property grob 'stencil))) (if (not (ly:stencil? gliss-stil)) ;; Warn if no Glissando.stencil is present, do nothing else (ly:warning "No stencil for ~a found, stopping here" grob) (let* ( ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; some generals ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (sys (ly:grob-system grob)) (layout (ly:grob-layout grob)) (blot (ly:output-def-lookup layout 'blot-diameter)) (staff-space (ly:staff-symbol-staff-space grob)) (line-thickness (ly:staff-symbol-line-thickness grob)) (half-line-thick (/ line-thickness 2)) (grob-thickness (ly:grob-property grob 'thickness 1)) (gliss-thick (* line-thickness grob-thickness)) ;; We use original not grob here to avoid not catching some ;; elements for broken glissando. (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)) ;; Glissando-stencil extents (gliss-stil-x-ext (ly:stencil-extent gliss-stil X)) (gliss-stil-y-ext (ly:stencil-extent gliss-stil Y)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Glissando-slope ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; The actual used glissando-gradient (calculated below) is ;; influenced by positive or negative slope. ;; ;; Simple slope could be retrieved by comparing Y-left/right. ;; We need X-left lateron, so we see no real need for ;; simplification here. (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)) (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-slope (/ (- Y-right Y-left) (- X-right X-left))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Glissando-gradient ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Using the previous found X/Y-left/right would lead to wrong ;; results for a broken spanner, thus we use the stencil's ;; extent, choosing the relevant car/cdr relying on the ;; previous calculated slope. (gliss-left-x (car gliss-stil-x-ext)) (gliss-right-x (cdr gliss-stil-x-ext)) (gliss-left-y (if (positive? gliss-slope) (car gliss-stil-y-ext) (cdr gliss-stil-y-ext))) (gliss-right-y (if (positive? gliss-slope) (cdr gliss-stil-y-ext) (car gliss-stil-y-ext))) (gliss-gradient (/ (+ (- gliss-right-y gliss-left-y) (* (if (positive? gliss-slope) -1 +1) gliss-thick)) (- gliss-right-x gliss-left-x))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; NoteColumns passed by Glissando ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; If the glissando starts/ends with a note which is beamed ;; already/further, include the relevant ;; left/right-bound-NoteColumn. ;; ;; Therefore we look at the Stem of grob's left/right-bound. ;; Include, if present and beamed. (include-me? (lambda (stem) (and (ly:grob? stem) (ly:grob? (ly:grob-object stem 'beam))))) (sys-elts-array (ly:grob-object sys 'all-elements)) ;; Filter for every inner (skipped) NoteColumn (inner-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:momentlist sys-elts-array))) ;; left/right-bound stem (left-bound-stem (ly:grob-object (ly:spanner-bound grob LEFT) 'stem)) (right-bound-stem (ly:grob-object (ly:spanner-bound grob RIGHT) 'stem)) ;; Probably take left/right-bound-NoteColumn into account (ncs (append (if (include-me? left-bound-stem) (list (ly:grob-parent left-bound-stem X)) '()) (if (include-me? right-bound-stem) (list (ly:grob-parent right-bound-stem X)) '()) inner-ncs)) ;; All Stems of the relevant NoteColumns (stems (map (lambda (nc) (ly:grob-object nc 'stem)) ncs)) (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)) (left-padding (assoc-get 'padding left-bound-info)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Intersection-points of Glissando and Stems ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (gliss-stem-intersections (map (lambda (stem-x-coord) (cons ;; For further coding of the "stemmed-glissando" the ;; car (representing the X-coordinate) of the here ;; calculated pair is not needed. We let it in here to ;; gain the possibility to add the cross-stencils for ;; debugging (see below). (+ (- stem-x-coord X-left) (- gliss-left-x left-padding) ;; TODO Is half-line-thick really what we want here? ;; Postponed, because we don't really need this half-line-thick) (+ ;; Calculate and add the Y-value of the glissando at ;; the given stem: we multiply the distance ;; from gliss-start to stem (modified by ;; left-padding) with the gradient. ;; NB The result is relative to zero-staff-line. (* gliss-gradient (- stem-x-coord X-left left-padding)) ;; Add the relevant value of Glissando's Y-extent: ;; If Glissando points down, use top Y-extent, ;; if it points up use bottom Y-extent. ;; Both corrected by half gliss-thick. (if (negative? gliss-gradient) (- (cdr gliss-stil-y-ext) (/ gliss-thick 2)) (+ (car gliss-stil-y-ext) (/ gliss-thick 2)))))) stems-x-coords))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; For conveniance/debugging ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Add cross-stencils where Stem and Glissando intersect ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;(define* ; (make-cross-stencil coords #:optional (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)))) ; ; (ly:grob-set-property! grob 'stencil ; (apply ly:stencil-add ; (ly:grob-property grob 'stencil) ; (map make-cross-stencil gliss-stem-intersections))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; 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)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Color left/right bound ;;;;;;;;;;;;;;;;;;;;;; ;(ly:grob-set-property! left-bound 'color red) ;(ly:grob-set-property! right-bound 'color green) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; 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)) ;; Get the the shortest duration of a Beam with mixed ;; durations. We go for the maximum of duration-log (beamed-stems-max-dur (if beamed-stems (apply max (map (lambda (stem) (ly:grob-property stem 'duration-log)) beamed-stems)) #f)) ;; Calculate beam-gradient, if beam is present ;; ;; Get a possible user-override for ;; Beam.details.beamed-glissando-stem-positions (beam-details (if (ly:grob? beam) (ly:grob-property beam 'details) #f)) (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 beamed-glissando-stem-positions (/ (- (cdr beamed-glissando-stem-positions) (car beamed-glissando-stem-positions)) (- (cdr beam-x-positions) (car beam-x-positions))) #f)) ;; If details.beamed-glissando-stem-positions is set, ;; 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 said beam. These values are ;; stored together with their Stem-grob in an alist and ;; referenced below. (beamed-stem-corrs (if beamed-glissando-stem-positions (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)) (gliss-details (ly:grob-property grob 'details)) (new-stem-y-ext (ordered-cons (+ (cdr gsi) (* stem-dir ;; If the glissando starts/ends with a note ;; which is beamed already/further, don't ;; apply pad-y to this stem. (if (or (equal? stem left-bound-stem) (equal? stem right-bound-stem)) 0 pad-y))) (if beamed-glissando-stem-positions ;; If a Beam is present *and* ;; beamed-glissando-stem-positions is set, use ;; the car of it for the initial Stem and add the ;; values of beamed-stem-corrs as appropriate. (+ (car beamed-glissando-stem-positions) (assoc-get stem beamed-stem-corrs)) ;; Otherwise calculate the Stems independently, ;; aiming at Beams parallel to the glissando ;; and else equal stem-lengths for equal ;; durations. ;; Rely on `beamed-lengths´ and `lengths´ from ;; Stem.details for it, so a user-override is ;; respected. (let* ((stem-details (ly:grob-property stem 'details))) (+ (* stem-dir staff-space (if (and beamed-stems-max-dur (member stem beamed-stems)) ;; For beamed Stems we always add the ;; same value to warrant parallel Beam ;; and Glissando. For Beams with ;; mixed durations we look at their ;; shortest duration, i.e. the maximum ;; of the stems duration-logs and take ;; this value for further calculation (let* ((beamed-lengths (assoc-get 'beamed-lengths stem-details ;; default: '(3.26 3.5 3.6))) (intlog (ly:intlog2 (denominator (duration-log-factor beamed-stems-max-dur)))) (stem-length (if (> intlog 4) (last beamed-lengths) (list-ref beamed-lengths (- intlog 3))))) ;; TODO little clumsy here... ;; probably use other Stem.details like: ;; - beamed-minimum-free-lengths ;; - beamed-extreme-minimum-free-lengths ;; - stem-shorten ;; as well. (+ stem-length ;; My choice - Harm (* 0.5 (- intlog 3)))) ;; For unbeamed Stems of 8th notes and ;; shorter we add some value relying on ;; their duration-log (let* ((unbeamed-lengths (assoc-get 'lengths stem-details ;; default '(3.5 3.5 3.5 4.25 5.0 6.0))) (stem-dur-log (ly:grob-property stem 'duration-log)) (intlog (ly:intlog2 (denominator (duration-log-factor stem-dur-log)))) (stem-length (cond ((= intlog 1) (car unbeamed-lengths)) ((<= intlog (1+ (length unbeamed-lengths))) (list-ref unbeamed-lengths (- intlog 2))) (else (last unbeamed-lengths))))) stem-length))) (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 ;; TODO below results in resetting Beam.positions ;; with every stem of the Beam. ;; How to simplify? (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 ;;;;;;;;;;; ;; Remark: Script will be positioned always at NoteHead-side, ;; never at Stem-side (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. ;; NB 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 (ly:grob-set-property! flag 'stencil (ly:stencil-translate-axis flag-stil (if (positive? stem-dir) (- (cdr new-stem-y-ext) (cdr stem-y-ext)) (- (car new-stem-y-ext) (car stem-y-ext))) 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)))))) %% Mmmh, the namings are misleading. The \arpeggio together with the applied %% `glissando-and-stems´ do the job. The two following definitions are merely %% helpers. startStemmedGlissando = { \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 } stopStemmedGlissando = { \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 } %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% EXAMPLES %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #(ly:message "\tSome TODOS for stemmed Glissando: \t- What about Dots in skipped NoteColumns, make them invisible? \t- Should we add other defaults for Stem.lengths/beamed-lengths? \t- Some minor TODOs inline...\n") %% 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)))) \paper { ragged-right = ##f } % { tst-I = \transpose b b' \new Staff { \voiceTwo \override Glissando.breakable = ##t \override Glissando.after-line-breaking = #(glissando-and-stems 0) b1\glissando \startStemmedGlissando \noBreak b2 b4 b \override Stem.details.beamed-lengths = #'(2.26 2.5 2.6) \repeat unfold 4 { c'16 d'32*2 d'64*4 e'128*8-> f' } \revert Stem.details.beamed-lengths \repeat unfold 4 { c'16 d' e' f' } \noBreak \repeat unfold 4 { c'16 d' e' f' } \noBreak g'2. \stopStemmedGlissando a'1 } \score { \tst-I \layout { ragged-right = ##t \autoBeamOff } } \score { \tst-I \layout { ragged-right = ##f \autoBeamOn } } %} % { { \override Glissando.breakable = ##t \override Glissando.after-line-breaking = #(glissando-and-stems 0) r2. \once \override Beam.details.beamed-glissando-stem-positions = #'(4 . 8) b8 b8\glissando \startStemmedGlissando \repeat unfold 4 { c'16 d' e' f' } \break \repeat unfold 4 { c'16 d' e' f' } \break \repeat unfold 2 { c'16 d' e' f' } %% The Glissando ends in the middle of some beamed notes. %% `glissando-and-stems´ is not smart enough to deal with this situation, thus %% some manual intervenrion is needed. \once \override Beam.details.beamed-glissando-stem-positions = #'(3 . 3.2) a' a' \stopStemmedGlissando a' a' } %} % { \transpose c c' { \voiceTwo \override Glissando.after-line-breaking = #(glissando-and-stems 0) % \override Glissando.breakable = ##t c''4\glissando \startStemmedGlissando %% 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 \stemUp g'2 \stopStemmedGlissando fis2 } %} mus = { c''4\glissando \startStemmedGlissando b'8-. \noBeam b'-> bes'-. \noBeam \override Stem.details.beamed-lengths = #'( 3.26 ;; 8 3.5 ;; 16 3.6 ;; 32 etc ) bes'8-.[ a'64*8-_ aes']-.---\prall %\break g'2 \stopStemmedGlissando 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 } %}