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
onceCenterNoteColumn =
#(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
}
}
}
%-------------------------------------------------------------%
_______________________________________________
lilypond-user mailing list
lilypond-user@gnu.org
https://lists.gnu.org/mailman/listinfo/lilypond-user
