Hi David, 2011/12/3 David Nalesnik <david.nales...@gmail.com>
> Hi again. > > On Fri, Dec 2, 2011 at 4:31 PM, David Nalesnik > <david.nales...@gmail.com>wrote: > >> >> (See attached file.) >> >> > Oops--that only accidentally works for your problem example since I goofed > the filtering. > > Replace the second definition of lst-2 in the file I last attached with > this line and all should be well: > > (lst-2 (remove (lambda (x) (interval-empty? (X-extent x))) lst-2)) > > -David > thanks a lot!! Meanwhile I detected the KeySignature with the extent of (+inf.0 . -inf.0), but I didn't had a proper solution. (My own was a very ugly hack, not worth to post.) But now there's a new problem. Sometimes I've to notice a very small, but visible displacement of the NoteColumn, if KeyCancellation is left bound and a new Clef is right bound (mes. 5 of the full test). And I can't figure out what's the difference between this measure and measure 7 of the full test or measure 2 of the tiny example. Any hint? BTW, is there any possibility to address a cross-staff-arpeggio with this function to get rid of the additional arpeggio-override? Best, Harm
\version "2.14.2" #(set-global-staff-size 20) #(define (helper ls1 ls2 ls3) "Constructs an alist with the elements of ls1 and ls2" (set! ls3 (assq-set! ls3 (car ls1) (car ls2))) (if (null? (cdr ls1)) ls3 (helper (cdr ls1) (cdr ls2) ls3))) #(define (helper-2 lst number) "Search the first element of the sorted lst, which is greater than number" (let ((ls (sort lst <))) (if (> (car ls) number) (car ls) (if (null? (cdr ls)) (begin (display "no member of the list is greater than the number") (newline)) (helper-2 (cdr ls) number))))) #(use-modules (srfi srfi-1)) #(define (delete-adjacent-duplicates lst) "Deletes adjacent duplicates in lst eg. '(1 1 2 2) -> '(1 2)" (fold-right (lambda (elem ret) (if (equal? elem (first ret)) ret (cons elem ret))) (list (last lst)) lst)) #(define (position-in-list obj ls) "Search the position of obj in ls" (define (position-in-list-helper obj ls bypassed) (if (null? ls) #f (if (equal? obj (car ls)) bypassed (position-in-list-helper obj (cdr ls) (+ bypassed 1)) ))) (position-in-list-helper obj ls 0)) #(define (center-note-column grob) (let* ((sys (ly:grob-system grob)) (array (ly:grob-object sys 'all-elements)) (grob-name (lambda (x) (assq-ref (ly:grob-property x 'meta) 'name))) (note-heads (ly:grob-object grob 'note-heads)) (X-extent (lambda (q) (ly:grob-extent q sys X))) ;; NoteHeads (note-heads-grobs (if (not (null? note-heads)) (ly:grob-array->list note-heads) '())) (one-note-head (if (not (null? note-heads-grobs)) (car note-heads-grobs) '())) (one-note-head-length (if (not (null? one-note-head)) (interval-length (ly:grob-extent one-note-head sys X)) 0)) ;; Stem (stem (ly:grob-object grob 'stem)) (stem-dir (ly:grob-property stem 'direction)) (stem-length-x (interval-length (ly:grob-extent stem sys X))) ;; DotColumn (dot-column (ly:note-column-dot-column grob)) ;; AccidentalPlacement (accidental-placement (ly:note-column-accidentals grob)) ;; Arpeggio (arpeggio (ly:grob-object grob 'arpeggio)) ;; Rest (rest (ly:grob-object grob 'rest)) ;; NoteColumn (note-column-coord (ly:grob-relative-coordinate grob sys X)) (grob-ext (ly:grob-extent grob sys X)) (grob-length (interval-length grob-ext)) ;; BarLine (lst-1 (filter (lambda (x) (eq? 'BarLine (grob-name x))) (ly:grob-array->list array))) (bar-coords (map (lambda (x) (ly:grob-relative-coordinate x sys X)) lst-1)) (bar-alist (helper bar-coords lst-1 '())) ;; KeySignature (lst-2a (filter (lambda (x) (eq? 'KeySignature (grob-name x))) (ly:grob-array->list array))) (lst-2 (remove (lambda (x) (interval-empty? (X-extent x))) lst-2a)) (key-sig-coords (map (lambda (x) (ly:grob-relative-coordinate x sys X)) lst-2)) (key-sig-alist (if (not (null? lst-2)) (helper key-sig-coords lst-2 '()) '())) ;; KeyCancellation (lst-3 (filter (lambda (x) (eq? 'KeyCancellation (grob-name x))) (ly:grob-array->list array))) (key-canc-coords (map (lambda (x) (ly:grob-relative-coordinate x sys X)) lst-3)) (key-canc-alist (if (not (null? lst-3)) (helper key-canc-coords lst-3 '()) '())) ;; TimeSignature (lst-4 (filter (lambda (x) (eq? 'TimeSignature (grob-name x))) (ly:grob-array->list array))) (time-sig-coords (map (lambda (x) (ly:grob-relative-coordinate x sys X)) lst-4)) (time-sig-alist (if (not (null? lst-4)) (helper time-sig-coords lst-4 '()) '())) ;; Clef (lst-5 (filter (lambda (x) (eq? 'Clef (grob-name x))) (ly:grob-array->list array))) (clef-coords (map (lambda (x) (ly:grob-relative-coordinate x sys X)) lst-5)) (clef-alist (if (not (null? lst-5)) (helper clef-coords lst-5 '()) '())) ;; Lists (coords-list (delete-adjacent-duplicates (sort (append bar-coords key-sig-coords key-canc-coords time-sig-coords clef-coords ) <))) (grob-alist (append bar-alist key-sig-alist key-canc-alist time-sig-alist clef-alist )) ;; Bounds (right-bound-coords (helper-2 coords-list note-column-coord)) (right-bound-position-in-coords-list (position-in-list right-bound-coords coords-list)) (left-bound-coords (list-ref coords-list (- right-bound-position-in-coords-list 1))) (grob-x1 (assoc-ref grob-alist left-bound-coords)) (grob-x2 (assoc-ref grob-alist right-bound-coords)) (bounds-coord (cons left-bound-coords right-bound-coords)) (bounds (cons grob-x1 grob-x2)) ) ;; End of Defs in let* (begin (newline) (display bounds-coord) (newline) (display bounds) (newline) (ly:grob-set-property! grob-x1 'color red) (ly:grob-set-property! grob-x2 'color blue) ;; simplified! (let* ((left (cdr (X-extent (car bounds)))) (right (car (X-extent (cdr bounds))))) (begin ;; NoteColumn (cond ((not (null? note-heads)) (if (= stem-dir -1) (ly:grob-translate-axis! grob (- (- (- (interval-center (X-extent grob)) (/ (+ left right) 2))) (if (> (interval-length (X-extent grob)) one-note-head-length) (* 0.25 grob-length) 0)) X) (ly:grob-translate-axis! grob (- (- (- (interval-center (X-extent grob)) (/ (+ left right) 2))) (if (> (interval-length (X-extent grob)) one-note-head-length) (* -0.25 grob-length) 0)) X)))) ;; DotColumn (cond ((ly:grob? dot-column) (let* ((dot-column-coord (ly:grob-relative-coordinate dot-column sys X)) (dot-note-dif (- dot-column-coord note-column-coord)) ) (ly:grob-translate-axis! dot-column (+ (- (- (interval-center (X-extent dot-column)) (/ (+ left right) 2))) dot-note-dif (* -1.5 stem-length-x)) X)))) ;; AccidentalPlacement (cond ((ly:grob? accidental-placement) (ly:grob-translate-axis! accidental-placement (- (- (- (interval-center (X-extent accidental-placement)) (/ (+ left right) 2))) (if (and (> (interval-length (X-extent grob)) one-note-head-length) (= stem-dir 1)) (* 0.8 grob-length) (* 1.25 grob-length))) X))) ;; Arpeggio (cond ((ly:grob? arpeggio) (let* ((arpeggio-coord (ly:grob-relative-coordinate arpeggio sys X)) (note-arp-dif (- note-column-coord arpeggio-coord)) ) (ly:grob-translate-axis! arpeggio (+ (- (- (interval-center (X-extent arpeggio)) (/ (+ left right) 2))) (if (ly:grob? accidental-placement) (* -1.2 note-arp-dif) (* -1.4 note-arp-dif))) X)))) ;; Rest (cond ((ly:grob? rest) (ly:grob-translate-axis! rest (+ (- (- (interval-center (X-extent rest)) (/ (+ left right) 2)))) X))) ) ) ) );; End of let* ) centerNoteColumnOn = \override Staff.NoteColumn #'after-line-breaking = #center-note-column centerNoteColumnOff = \revert Staff.NoteColumn #'after-line-breaking onceCenterNoteColumn = \once \override Staff.NoteColumn #'after-line-breaking = #center-note-column %------------ Test \paper { ragged-right = ##f } % tiny example: << \new Staff { \time 3/4 \key b\minor R2.*3 } \new Staff { \time 3/4 \key b\minor b''2. \key a\minor \onceCenterNoteColumn <a'' bes''> \clef "treble" R } >> %%{ % full test: \layout { indent = 0 \context { \Score \override NonMusicalPaperColumn #'line-break-permission = ##f \override BarNumber #'break-visibility = #'#(#t #t #t) } \context { \Staff %\remove Time_signature_engraver %\remove Key_engraver %\remove Clef_engraver } } \markup \vspace #2 testVoice = \relative c' { \key b\minor \time 3/4 b'2_"Zeit?" r4 \key g\minor \time 3/4 \clef "bass" R2. \key a\minor \time 3/4 \clef "treble" R2. \key g\minor \clef "bass" R2. \key a\minor \clef "treble" %5 R2. \break \key g\minor \clef "bass" R2. \key a\minor \clef "treble" %7 R2. \key g\minor \clef "bass" R2.*1\fermataMarkup \key a\minor \clef "treble" R \bar "|." } voice = \relative c' { \key b\minor \time 3/4 b'2 r4 R2.*6 R2.*1\fermataMarkup R \bar "|." } pUp = \relative c' { \key b\minor \clef "bass" \time 3/4 % \stemUp <d, fis b>2.\pp ( \centerNoteColumnOn \once \override Score.Arpeggio #'padding = #-1.5 \set Score.connectArpeggios = ##t <fis ais>\arpeggio <fis d'> <e g c!> ) %5 <dis fis a! b> ( <e g b> ) %7 <dis fis b> ~ <dis fis b>\fermata r } pDown = \relative c' { \key b\minor \clef "bass" \time 3/4 %\stemDown <b,, fis' b>2. ( | \centerNoteColumnOn <ais fis' ais>\arpeggio | <d fis d'> | <c g' c> ) | %5 <b b'> ~ | <b b'>-.-> | %7 <b b'> ~ | <b b'>\fermata | r } << \new Staff %\voice \testVoice \new PianoStaff << \new Staff << \pUp >> \new Staff << \pDown >> >> >>
_______________________________________________ lilypond-user mailing list lilypond-user@gnu.org https://lists.gnu.org/mailman/listinfo/lilypond-user