lilypond-user
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Put the text on the left above a centered note


From: Tommaso Gordini
Subject: Put the text on the left above a centered note
Date: Tue, 27 Aug 2013 20:18:41 +0200

Hello to all,
is possible to put some text to the left above a centered note in a bar?

I have to write something like that that you see below. If you think that everything is OK, no problem.

Ciao
Tommaso

Here's the code:

%-------------------------------------------------------------%

\version "2.16.2"


#(define (sort-by-X-coord sys grob-lst)

"Arranges a list of grobs in ascending order by their X-coordinates"

(let* ((X-coord (lambda (x) (ly:grob-relative-coordinate x sys X)))

(comparator (lambda (p q) (< (X-coord p) (X-coord q)))))

(sort grob-lst comparator)))

#(define (find-bounding-grobs note-column grob-lst)

(let* ((sys (ly:grob-system note-column))

(X-coord (lambda (n) (ly:grob-relative-coordinate n sys X)))

(note-column-X (X-coord note-column)))

(define (helper lst)

(if (and (< (X-coord (car lst)) note-column-X)

(> (X-coord (cadr lst)) note-column-X))

(cons (car lst) (cadr lst))

(if (null? (cddr lst))

(cons note-column note-column)

(helper (cdr lst)))))

(helper grob-lst)))


#(define (read-out l1 l2)

(define (helper ls1 ls2 ls3)

"Filters all elements of ls1 from ls2 by their grob-name and appends it to ls3"

(let ((grob-name-proc (lambda (x) (assq-ref (ly:grob-property x 'meta) 'name))))

(if (null? ls1)

ls3

(helper

(cdr ls1)

ls2

(append ls3 (filter (lambda (x) (eq? (car ls1) (grob-name-proc x))) ls2))))))

(helper l1 l2 '()))

#(define ((center-note-column x-offs) grob)

(let* ((sys (ly:grob-system grob))

(elements-lst (ly:grob-array->list (ly:grob-object sys 'all-elements)))

(grob-name (lambda (x) (assq-ref (ly:grob-property x 'meta) 'name)))

(X-extent (lambda (q) (ly:grob-extent q sys X)))

;; NoteColumn

(note-column-coord (ly:grob-relative-coordinate grob sys X))

(grob-ext (X-extent grob))

(grob-length (interval-length grob-ext))

;; NoteHeads

(note-heads (ly:grob-object grob 'note-heads))

(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 (X-extent one-note-head)) ;; NB

0))

;; Stem

(stem (ly:grob-object grob 'stem))

(stem-dir (ly:grob-property stem 'direction))

(stem-length-x (interval-length (X-extent stem))) ;; NB

;; 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))

;; BassFigure + ChordName

(other-grobs-to-center

;; TODO

;; Not sure: What belongs to the list, what not?

(list 'BassFigure

;'BassFigureAlignment

;'BassFigureAlignmentPositioning

'BassFigureBracket

'BassFigureContinuation

;'BassFigureLine

'ChordName

'FretBoard

))

(all-other-grobs (read-out other-grobs-to-center elements-lst))

(condensed-other-grobs

(remove

(lambda (x)

(not (= (ly:grob-relative-coordinate x sys X)

note-column-coord)))

all-other-grobs))

;; Grobs to center between

(args (list 'BarLine

'Clef

'KeySignature

'KeyCancellation

'TimeSignature))

(grob-lst (read-out args elements-lst))

(new-grob-lst (remove (lambda (x) (interval-empty? (X-extent x))) grob-lst))

(sorted-grob-lst (sort-by-X-coord sys new-grob-lst))

;; Bounds

(bounds (find-bounding-grobs grob sorted-grob-lst))

(left (cdr (X-extent (car bounds))))

(right (car (X-extent (cdr bounds))))

;;(bounds-coord (cons left right)) ;; delete

(basic-offset

(- (average left right)

(interval-center (X-extent grob))

(* -1 x-offs)))

(dir-correction

(if (> grob-length one-note-head-length)

(* stem-dir (* -2 stem-length-x) grob-length)

0))

) ;; End of Defs in let*

;; Calculation

(begin

;; (display "\n\taccidental-placement: \t")(write accidental-placement)

(for-each

(lambda (x)

(cond ((ly:grob? x)

(ly:grob-translate-axis!

x

(- basic-offset dir-correction)

X))))

(append

(list

(cond ((not (null? note-heads)) grob))

dot-column

accidental-placement

arpeggio)

condensed-other-grobs)))))


centerNoteColumnOn = \override Staff.NoteColumn #'after-line-breaking = #(center-note-column 0)


centerNoteColumnOff = \revert Staff.NoteColumn #'after-line-breaking


>

#(define-music-function (parser location x-offs)(number?)

#{

\once \override Staff.NoteColumn #'after-line-breaking = #(center-note-column x-offs)

#})


% from:

% http://lsr.dsi.unimi.it/LSR/Item?id=637

#(define (Text_align_engraver ctx)

(let ((scripts '())

(note-column #f))


`((acknowledgers

(note-column-interface

. ,(lambda (trans grob source)

;; cache NoteColumn in this Voice context

(set! note-column grob)))


(text-script-interface

. ,(lambda (trans grob source)

;; whenever a TextScript is acknowledged,

;; add it to `scripts' list

(set! scripts (cons grob scripts)))))


(stop-translation-timestep

. ,(lambda (trans)

;; if any TextScript grobs exist,

;; set NoteColumn as X-parent

(and (pair? scripts)

(for-each (lambda (script)

(set! (ly:grob-parent script X) note-column))

scripts))

;; clear scripts ready for next timestep

(set! scripts '()))))))




fingerChart =

#(define-event-function (parser location arg)(string?)

#{

\tweak #'text

\markup

\override #'(baseline-skip . 2)

\finger

\center-column {

$(string-split arg #\+)

}

-""

#})



global = {

\key c \major

\time 4/4

\clef "bass"

\centerNoteColumnOn

}


\score {

\relative c {

\global

\transposition f


% The music:


f,1_\fingerChart "0"^\markup { \small "Si" \flat }

\bar "||"

fis_\fingerChart "1 - 2 - 3"^\markup { \small "Fa" }

g_\fingerChart "1 - 3"

}


\layout {

\context {

\Score

\remove "Bar_number_engraver"

}

\context {

\Staff

\remove "Time_signature_engraver"

}

\context {

\Voice

\consists #Text_align_engraver

\override TextScript #'X-offset =

#ly:self-alignment-interface::aligned-on-x-parent

\override TextScript #'self-alignment-X = #CENTER

\override TextScript #'padding = 2

}

}

}


%-------------------------------------------------------------%

reply via email to

[Prev in Thread] Current Thread [Next in Thread]