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
